warp 3.3.22 → 3.3.23
raw patch · 16 files changed
+92/−332 lines, 16 filesdep +recvdep −HUnitdep −async
Dependencies added: recv
Dependencies removed: HUnit, async
Files
- ChangeLog.md +9/−0
- Network/Wai/Handler/Warp.hs +13/−1
- Network/Wai/Handler/Warp/Buffer.hs +4/−70
- Network/Wai/Handler/Warp/HTTP2.hs +6/−3
- Network/Wai/Handler/Warp/Imports.hs +0/−2
- Network/Wai/Handler/Warp/Internal.hs +1/−2
- Network/Wai/Handler/Warp/Recv.hs +0/−160
- Network/Wai/Handler/Warp/Request.hs +1/−1
- Network/Wai/Handler/Warp/Response.hs +1/−0
- Network/Wai/Handler/Warp/ResponseHeader.hs +2/−1
- Network/Wai/Handler/Warp/Run.hs +17/−14
- Network/Wai/Handler/Warp/SendFile.hs +1/−0
- Network/Wai/Handler/Warp/Settings.hs +24/−1
- Network/Wai/Handler/Warp/Types.hs +2/−18
- test/BufferPoolSpec.hs +0/−47
- warp.cabal +11/−12
ChangeLog.md view
@@ -1,5 +1,14 @@ # ChangeLog for warp +## 3.3.23++* Add `setAccept` for hooking the socket `accept` call.+ [#912](https://github.com/yesodweb/wai/pull/912)+* Removed some package dependencies from test suite+ [#902](https://github.com/yesodweb/wai/pull/902)+* Factored out `Network.Wai.Handler.Warp.Recv` to its own package `recv`.+ [#899](https://github.com/yesodweb/wai/pull/899)+ ## 3.3.22 * Creating a bigger buffer when the current one is too small to fit the Builder
Network/Wai/Handler/Warp.hs view
@@ -64,6 +64,7 @@ , setServerName , setMaximumBodyFlush , setFork+ , setAccept , setProxyProtocolNone , setProxyProtocolRequired , setProxyProtocolOptional@@ -135,7 +136,7 @@ import Data.X509 #endif import qualified Network.HTTP.Types as H-import Network.Socket (SockAddr)+import Network.Socket (Socket, SockAddr) import Network.Wai (Request, Response, vault) import System.TimeManager @@ -369,6 +370,17 @@ -- Since 3.0.4 setFork :: (((forall a. IO a -> IO a) -> IO ()) -> IO ()) -> Settings -> Settings setFork fork' s = s { settingsFork = fork' }++-- | Code to accept a new connection.+--+-- Useful if you need to provide connected sockets from something other+-- than a standard accept call.+--+-- Default: 'defaultAccept'+--+-- Since 3.3.24+setAccept :: (Socket -> IO (Socket, SockAddr)) -> Settings -> Settings+setAccept accept' s = s { settingsAccept = accept' } -- | Do not use the PROXY protocol. --
Network/Wai/Handler/Warp/Buffer.hs view
@@ -2,25 +2,18 @@ module Network.Wai.Handler.Warp.Buffer ( createWriteBuffer- , bufferSize , allocateBuffer , freeBuffer- , mallocBS- , newBufferPool- , withBufferPool , toBuilderBuffer- , copy , bufferIO ) where -import qualified Data.ByteString as BS-import Data.ByteString.Internal (memcpy)-import Data.ByteString.Unsafe (unsafeTake, unsafeDrop)-import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.IORef (IORef, readIORef) import qualified Data.Streaming.ByteString.Builder.Buffer as B (Buffer (..)) import Foreign.ForeignPtr-import Foreign.Marshal.Alloc (mallocBytes, free, finalizerFree)-import Foreign.Ptr (castPtr, plusPtr)+import Foreign.Marshal.Alloc (mallocBytes, free)+import Foreign.Ptr (plusPtr)+import Network.Socket.BufferPool import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types@@ -41,13 +34,6 @@ ---------------------------------------------------------------- --- | The default size of the write buffer: 16384 (2^14 = 1024 * 16).--- This is the maximum size of TLS record.--- This is also the maximum size of HTTP/2 frame payload--- (excluding frame header).-bufferSize :: BufSize-bufferSize = 16384- -- | Allocating a buffer with malloc(). allocateBuffer :: Int -> IO Buffer allocateBuffer = mallocBytes@@ -57,50 +43,6 @@ freeBuffer = free ------------------------------------------------------------------largeBufferSize :: Int-largeBufferSize = 16384--minBufferSize :: Int-minBufferSize = 2048--newBufferPool :: IO BufferPool-newBufferPool = newIORef BS.empty--mallocBS :: Int -> IO ByteString-mallocBS size = do- ptr <- allocateBuffer size- fptr <- newForeignPtr finalizerFree ptr- return $! PS fptr 0 size-{-# INLINE mallocBS #-}--usefulBuffer :: ByteString -> Bool-usefulBuffer buffer = BS.length buffer >= minBufferSize-{-# INLINE usefulBuffer #-}--getBuffer :: BufferPool -> IO ByteString-getBuffer pool = do- buffer <- readIORef pool- if usefulBuffer buffer then return buffer else mallocBS largeBufferSize-{-# INLINE getBuffer #-}--putBuffer :: BufferPool -> ByteString -> IO ()-putBuffer pool buffer = writeIORef pool buffer-{-# INLINE putBuffer #-}--withForeignBuffer :: ByteString -> ((Buffer, BufSize) -> IO Int) -> IO Int-withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s, l)-{-# INLINE withForeignBuffer #-}--withBufferPool :: BufferPool -> ((Buffer, BufSize) -> IO Int) -> IO ByteString-withBufferPool pool f = do- buffer <- getBuffer pool- consumed <- withForeignBuffer buffer f- putBuffer pool $! unsafeDrop consumed buffer- return $! unsafeTake consumed buffer-{-# INLINE withBufferPool #-}------------------------------------------------------------------ -- -- Utilities --@@ -112,14 +54,6 @@ size = bufSize writeBuffer fptr <- newForeignPtr_ ptr return $ B.Buffer fptr ptr ptr (ptr `plusPtr` size)---- | Copying the bytestring to the buffer.--- This function returns the point where the next copy should start.-copy :: Buffer -> ByteString -> IO Buffer-copy !ptr (PS fp o l) = withForeignPtr fp $ \p -> do- memcpy ptr (p `plusPtr` o) (fromIntegral l)- return $! ptr `plusPtr` l-{-# INLINE copy #-} bufferIO :: Buffer -> Int -> (ByteString -> IO ()) -> IO () bufferIO ptr siz io = do
Network/Wai/Handler/Warp/HTTP2.hs view
@@ -9,16 +9,17 @@ , http2server ) where -import qualified UnliftIO import qualified Data.ByteString as BS import Data.IORef (IORef, newIORef, writeIORef, readIORef) import qualified Data.IORef as I import qualified Network.HTTP2.Frame as H2 import qualified Network.HTTP2.Server as H2 import Network.Socket (SockAddr)+import Network.Socket.BufferPool import Network.Wai import Network.Wai.Internal (ResponseReceived(..)) import qualified System.TimeManager as T+import qualified UnliftIO import Network.Wai.Handler.Warp.HTTP2.File import Network.Wai.Handler.Warp.HTTP2.PushPromise@@ -27,7 +28,6 @@ import Network.Wai.Handler.Warp.Imports import qualified Network.Wai.Handler.Warp.Settings as S import Network.Wai.Handler.Warp.Types-import Network.Wai.Handler.Warp.Recv ---------------------------------------------------------------- @@ -115,7 +115,7 @@ wrappedRecvN :: T.Handle -> IORef Bool -> Int -> (BufSize -> IO ByteString) -> (BufSize -> IO ByteString) wrappedRecvN th istatus slowlorisSize readN bufsize = do- bs <- readN bufsize+ bs <- UnliftIO.handleAny handler $ readN bufsize unless (BS.null bs) $ do writeIORef istatus True -- TODO: think about the slowloris protection in HTTP2: current code@@ -125,6 +125,9 @@ -- deployments with large NATs may be trickier). when (BS.length bs >= slowlorisSize || bufsize <= slowlorisSize) $ T.tickle th return bs+ where+ handler :: UnliftIO.SomeException -> IO ByteString+ handler _ = return "" -- connClose must not be called here since Run:fork calls it goaway :: Connection -> H2.ErrorCodeId -> ByteString -> IO ()
Network/Wai/Handler/Warp/Imports.hs view
@@ -4,7 +4,6 @@ , module Control.Applicative , module Control.Monad , module Data.Bits- , module Data.List , module Data.Int , module Data.Monoid , module Data.Ord@@ -18,7 +17,6 @@ import Data.Bits import Data.ByteString.Internal (ByteString(..)) import Data.Int-import Data.List import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe import Data.Monoid
Network/Wai/Handler/Warp/Internal.hs view
@@ -21,7 +21,6 @@ , BufSize , WriteBuffer(..) , createWriteBuffer- , bufferSize , allocateBuffer , freeBuffer , copy@@ -75,6 +74,7 @@ , pReadMaker ) where +import Network.Socket.BufferPool import System.TimeManager import Network.Wai.Handler.Warp.Buffer@@ -84,7 +84,6 @@ import Network.Wai.Handler.Warp.HTTP2 import Network.Wai.Handler.Warp.HTTP2.File import Network.Wai.Handler.Warp.Header-import Network.Wai.Handler.Warp.Recv import Network.Wai.Handler.Warp.Request import Network.Wai.Handler.Warp.Response import Network.Wai.Handler.Warp.Run
− Network/Wai/Handler/Warp/Recv.hs
@@ -1,160 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface, OverloadedStrings #-}-{-# LANGUAGE CPP #-}--module Network.Wai.Handler.Warp.Recv (- receive- , receiveBuf- , makeReceiveN- , makePlainReceiveN- , spell- ) where--import qualified UnliftIO-import qualified Data.ByteString as BS-import Data.IORef-import Foreign.C.Error (eAGAIN, getErrno, throwErrno)-import Foreign.C.Types-import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Ptr (Ptr, castPtr, plusPtr)-import GHC.Conc (threadWaitRead)-import qualified GHC.IO.Exception as E-import Network.Socket (Socket)-import qualified System.IO.Error as E-#if MIN_VERSION_network(3,1,0)-import Network.Socket (withFdSocket)-#else-import Network.Socket (fdSocket)-#endif-import System.Posix.Types (Fd(..))--import Network.Wai.Handler.Warp.Buffer-import Network.Wai.Handler.Warp.Imports-import Network.Wai.Handler.Warp.Types--#ifdef mingw32_HOST_OS-import GHC.IO.FD (FD(..), readRawBufferPtr)-import Network.Wai.Handler.Warp.Windows-#endif--------------------------------------------------------------------makeReceiveN :: ByteString -> Recv -> RecvBuf -> IO (BufSize -> IO ByteString)-makeReceiveN bs0 recv recvBuf = do- ref <- newIORef bs0- return $ receiveN ref recv recvBuf---- | This function returns a receiving function--- based on two receiving functions.--- The returned function efficiently manages received data--- which is initialized by the first argument.--- The returned function may allocate a byte string with malloc().-makePlainReceiveN :: Socket -> ByteString -> IO (BufSize -> IO ByteString)-makePlainReceiveN s bs0 = do- ref <- newIORef bs0- pool <- newBufferPool- return $ receiveN ref (receive s pool) (receiveBuf s)--receiveN :: IORef ByteString -> Recv -> RecvBuf -> BufSize -> IO ByteString-receiveN ref recv recvBuf size = UnliftIO.handleAny handler $ do- cached <- readIORef ref- (bs, leftover) <- spell cached size recv recvBuf- writeIORef ref leftover- return bs- where- handler :: UnliftIO.SomeException -> IO ByteString- handler _ = return ""--------------------------------------------------------------------spell :: ByteString -> BufSize -> IO ByteString -> RecvBuf -> IO (ByteString, ByteString)-spell init0 siz0 recv recvBuf- | siz0 <= len0 = return $ BS.splitAt siz0 init0- -- fixme: hard coding 4096- | siz0 <= 4096 = loop [init0] (siz0 - len0)- | otherwise = do- bs@(PS fptr _ _) <- mallocBS siz0- withForeignPtr fptr $ \ptr -> do- ptr' <- copy ptr init0- full <- recvBuf ptr' (siz0 - len0)- if full then- return (bs, "")- else- return ("", "") -- fixme- where- len0 = BS.length init0- loop bss siz = do- bs <- recv- let len = BS.length bs- if len == 0 then- return ("", "")- else if len >= siz then do- let (consume, leftover) = BS.splitAt siz bs- ret = BS.concat $ reverse (consume : bss)- return (ret, leftover)- else do- let bss' = bs : bss- siz' = siz - len- loop bss' siz'---- The timeout manager may close the socket.--- In that case, an error of "Bad file descriptor" occurs.--- We ignores it because we expect TimeoutThread.-receive :: Socket -> BufferPool -> Recv-receive sock pool = UnliftIO.handleIO handler $ withBufferPool pool $ \ (ptr, size) -> do-#if MIN_VERSION_network(3,1,0)- withFdSocket sock $ \fd -> do-#elif MIN_VERSION_network(3,0,0)- fd <- fdSocket sock-#else- let fd = fdSocket sock-#endif- let size' = fromIntegral size- fromIntegral <$> receiveloop fd ptr size'- where- handler :: UnliftIO.IOException -> IO ByteString- handler e- | E.ioeGetErrorType e == E.InvalidArgument = return ""- | otherwise = UnliftIO.throwIO e--receiveBuf :: Socket -> RecvBuf-receiveBuf sock buf0 siz0 = do-#if MIN_VERSION_network(3,1,0)- withFdSocket sock $ \fd -> do-#elif MIN_VERSION_network(3,0,0)- fd <- fdSocket sock-#else- let fd = fdSocket sock-#endif- loop fd buf0 siz0- where- loop _ _ 0 = return True- loop fd buf siz = do- n <- fromIntegral <$> receiveloop fd buf (fromIntegral siz)- -- fixme: what should we do in the case of n == 0- if n == 0 then- return False- else- loop fd (buf `plusPtr` n) (siz - n)--receiveloop :: CInt -> Ptr Word8 -> CSize -> IO CInt-receiveloop sock ptr size = do-#ifdef mingw32_HOST_OS- bytes <- windowsThreadBlockHack $ fromIntegral <$> readRawBufferPtr "recv" (FD sock 1) (castPtr ptr) 0 size-#else- bytes <- c_recv sock (castPtr ptr) size 0-#endif- if bytes == -1 then do- errno <- getErrno- if errno == eAGAIN then do- threadWaitRead (Fd sock)- receiveloop sock ptr size- else- throwErrno "receiveloop"- else- return bytes--#ifndef mingw32_HOST_OS--- fixme: the type of the return value-foreign import ccall unsafe "recv"- c_recv :: CInt -> Ptr CChar -> CSize -> CInt -> IO CInt-#endif
Network/Wai/Handler/Warp/Request.hs view
@@ -39,7 +39,7 @@ import Network.Wai.Handler.Warp.Conduit import Network.Wai.Handler.Warp.FileInfoCache import Network.Wai.Handler.Warp.Header-import Network.Wai.Handler.Warp.Imports hiding (readInt, lines)+import Network.Wai.Handler.Warp.Imports hiding (readInt) import Network.Wai.Handler.Warp.ReadInt import Network.Wai.Handler.Warp.RequestHeader import Network.Wai.Handler.Warp.Settings (Settings, settingsNoParsePath, settingsMaxTotalHeaderLength)
Network/Wai/Handler/Warp/Response.hs view
@@ -23,6 +23,7 @@ import qualified Data.ByteString.Char8 as C8 import qualified Data.CaseInsensitive as CI import Data.Function (on)+import Data.List (deleteBy) import Data.Streaming.ByteString.Builder (newByteStringBuilderRecv, reuseBufferStrategy) import Data.Version (showVersion) import Data.Word8 (_cr, _lf)
Network/Wai/Handler/Warp/ResponseHeader.hs view
@@ -6,11 +6,12 @@ import qualified Data.ByteString as S import Data.ByteString.Internal (create) import qualified Data.CaseInsensitive as CI+import Data.List (foldl') import Foreign.Ptr import GHC.Storable import qualified Network.HTTP.Types as H+import Network.Socket.BufferPool (copy) -import Network.Wai.Handler.Warp.Buffer (copy) import Network.Wai.Handler.Warp.Imports ----------------------------------------------------------------
Network/Wai/Handler/Warp/Run.hs view
@@ -8,25 +8,26 @@ module Network.Wai.Handler.Warp.Run where import Control.Arrow (first)-import Control.Exception (allowInterrupt) import qualified Control.Exception-import qualified UnliftIO-import UnliftIO (toException)+import Control.Exception (allowInterrupt) import qualified Data.ByteString as S import Data.IORef (newIORef, readIORef) import Data.Streaming.Network (bindPortTCP) import Foreign.C.Error (Errno(..), eCONNABORTED, eMFILE) import GHC.IO.Exception (IOException(..), IOErrorType(..))-import Network.Socket (Socket, close, accept, withSocketsDo, SockAddr, setSocketOption, SocketOption(..))+import Network.Socket (Socket, close, withSocketsDo, SockAddr, setSocketOption, SocketOption(..)) #if MIN_VERSION_network(3,1,1) import Network.Socket (gracefulClose) #endif+import Network.Socket.BufferPool import qualified Network.Socket.ByteString as Sock import Network.Wai import System.Environment (lookupEnv) import System.IO.Error (ioeGetErrorType) import qualified System.TimeManager as T import System.Timeout (timeout)+import qualified UnliftIO+import UnliftIO (toException) import Network.Wai.Handler.Warp.Buffer import Network.Wai.Handler.Warp.Counter@@ -37,7 +38,6 @@ import Network.Wai.Handler.Warp.HTTP2 (http2) import Network.Wai.Handler.Warp.HTTP2.Types (isHTTP2) import Network.Wai.Handler.Warp.Imports hiding (readInt)-import Network.Wai.Handler.Warp.Recv import Network.Wai.Handler.Warp.SendFile import Network.Wai.Handler.Warp.Settings import Network.Wai.Handler.Warp.Types@@ -56,8 +56,8 @@ #else socketConnection _ s = do #endif- bufferPool <- newBufferPool- writeBuffer <- createWriteBuffer bufferSize+ bufferPool <- newBufferPool 2048 16384+ writeBuffer <- createWriteBuffer 16384 writeBufferRef <- newIORef writeBuffer isH2 <- newIORef False -- HTTP/1.x return Connection {@@ -76,12 +76,19 @@ #else , connClose = close s #endif- , connRecv = receive s bufferPool+ , connRecv = receive' s bufferPool , connRecvBuf = receiveBuf s , connWriteBuffer = writeBufferRef , connHTTP2 = isH2 } where+ receive' sock pool = UnliftIO.handleIO handler $ receive sock pool+ where+ handler :: UnliftIO.IOException -> IO ByteString+ handler e+ | ioeGetErrorType e == InvalidArgument = return ""+ | otherwise = UnliftIO.throwIO e+ sendfile writeBufferRef fid offset len hook headers = do writeBuffer <- readIORef writeBufferRef sendFile s (bufBuffer writeBuffer) (bufSize writeBuffer) sendall@@ -142,16 +149,12 @@ -- Note that the 'settingsPort' will still be passed to 'Application's via the -- 'serverPort' record. runSettingsSocket :: Settings -> Socket -> Application -> IO ()-runSettingsSocket set socket app = do+runSettingsSocket set@Settings{settingsAccept = accept'} socket app = do settingsInstallShutdownHandler set closeListenSocket runSettingsConnection set getConn app where getConn = do-#if WINDOWS- (s, sa) <- windowsThreadBlockHack $ accept socket-#else- (s, sa) <- accept socket-#endif+ (s, sa) <- accept' socket setSocketCloseOnExec s -- NoDelay causes an error for AF_UNIX. setSocketOption s NoDelay 1 `UnliftIO.catchAny` \(UnliftIO.SomeException _) -> return ()
Network/Wai/Handler/Warp/SendFile.hs view
@@ -11,6 +11,7 @@ import qualified Data.ByteString as BS import Network.Socket (Socket)+import Network.Socket.BufferPool #ifdef WINDOWS import Foreign.ForeignPtr (newForeignPtr_)
Network/Wai/Handler/Warp/Settings.hs view
@@ -16,7 +16,7 @@ import Data.Version (showVersion) import GHC.IO.Exception (IOErrorType(..), AsyncException (ThreadKilled)) import qualified Network.HTTP.Types as H-import Network.Socket (SockAddr)+import Network.Socket (Socket, SockAddr, accept) import Network.Wai import qualified Paths_warp import System.IO (stderr)@@ -25,6 +25,7 @@ import Network.Wai.Handler.Warp.Imports import Network.Wai.Handler.Warp.Types+import Network.Wai.Handler.Warp.Windows (windowsThreadBlockHack) -- | Various Warp server settings. This is purposely kept as an abstract data -- type so that new settings can be added without breaking backwards@@ -67,6 +68,16 @@ -- -- Since 3.0.4 + , settingsAccept :: Socket -> IO (Socket, SockAddr)+ -- ^ Code to accept a new connection.+ --+ -- Useful if you need to provide connected sockets from something other+ -- than a standard accept call.+ --+ -- Default: 'defaultAccept'+ --+ -- Since 3.3.24+ , settingsNoParsePath :: Bool -- ^ Perform no parsing on the rawPathInfo. --@@ -178,6 +189,7 @@ , settingsFileInfoCacheDuration = 0 , settingsBeforeMainLoop = return () , settingsFork = defaultFork+ , settingsAccept = defaultAccept , settingsNoParsePath = False , settingsInstallShutdownHandler = const $ return () , settingsServerName = C8.pack $ "Warp/" ++ showVersion Paths_warp.version@@ -274,4 +286,15 @@ case (fork# (io unsafeUnmask) s0) of (# s1, _tid #) -> (# s1, () #)+#endif++-- | Standard "accept" call for a listening socket.+--+-- @since 3.3.24+defaultAccept :: Socket -> IO (Socket, SockAddr)+defaultAccept =+#if WINDOWS+ windowsThreadBlockHack . accept+#else+ accept #endif
Network/Wai/Handler/Warp/Types.hs view
@@ -11,7 +11,7 @@ #ifdef MIN_VERSION_x509 import Data.X509 #endif-import Foreign.Ptr (Ptr)+import Network.Socket.BufferPool import System.Posix.Types (Fd) import qualified System.TimeManager as T @@ -88,12 +88,6 @@ -- Since: 3.1.0 type SendFile = FileId -> Integer -> Integer -> IO () -> [ByteString] -> IO () --- | Type for read buffer pool-type BufferPool = IORef ByteString---- | Type for buffer-type Buffer = Ptr Word8- -- | A write buffer of a specified size -- containing bytes and a way to free the buffer. data WriteBuffer = WriteBuffer {@@ -105,16 +99,6 @@ , bufFree :: IO () } --- | Type for buffer size-type BufSize = Int---- | Type for the action to receive input data-type Recv = IO ByteString---- | Type for the action to receive input data with a buffer.--- The result boolean indicates whether or not the buffer is fully filled.-type RecvBuf = Buffer -> BufSize -> IO Bool- -- | Data type to manipulate IO actions for connections. -- This is used to abstract IO actions for plain HTTP and HTTP over TLS. data Connection = Connection {@@ -128,7 +112,7 @@ -- called once. Other functions (like 'connRecv') may be called after -- 'connClose' is called. , connClose :: IO ()- -- | The connection receiving function. This returns "" for EOF.+ -- | The connection receiving function. This returns "" for EOF or exceptions. , connRecv :: Recv -- | The connection receiving function. This tries to fill the buffer. -- This returns when the buffer is filled or reaches EOF.
− test/BufferPoolSpec.hs
@@ -1,47 +0,0 @@-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
warp.cabal view
@@ -1,5 +1,5 @@ Name: warp-Version: 3.3.22+Version: 3.3.23 Synopsis: A fast, light-weight web server for WAI applications. License: MIT License-file: LICENSE@@ -50,6 +50,7 @@ , http-types >= 0.12 , http2 >= 3.0 && < 5 , iproute >= 1.3.1+ , recv , simple-sendfile >= 0.2.7 && < 0.3 , stm >= 2.3 , streaming-commons >= 0.1.10@@ -91,7 +92,6 @@ Network.Wai.Handler.Warp.Imports Network.Wai.Handler.Warp.PackInt Network.Wai.Handler.Warp.ReadInt- Network.Wai.Handler.Warp.Recv Network.Wai.Handler.Warp.Request Network.Wai.Handler.Warp.RequestHeader Network.Wai.Handler.Warp.Response@@ -135,8 +135,7 @@ Test-Suite spec Main-Is: Spec.hs- Other-modules: BufferPoolSpec- ConduitSpec+ Other-modules: ConduitSpec ExceptionSpec FdCacheSpec FileSpec@@ -170,7 +169,6 @@ Network.Wai.Handler.Warp.MultiMap Network.Wai.Handler.Warp.PackInt Network.Wai.Handler.Warp.ReadInt- Network.Wai.Handler.Warp.Recv Network.Wai.Handler.Warp.Request Network.Wai.Handler.Warp.RequestHeader Network.Wai.Handler.Warp.Response@@ -189,10 +187,8 @@ Ghc-Options: -Wall -threaded Build-Tool-Depends: hspec-discover:hspec-discover Build-Depends: base >= 4.8 && < 5- , HUnit , QuickCheck , array- , async , auto-update , bsb-http-chunked < 0.1 , bytestring >= 0.9.1.4@@ -209,11 +205,11 @@ , iproute >= 1.3.1 , network , process+ , recv , simple-sendfile >= 0.2.4 && < 0.3 , stm >= 2.3 , streaming-commons >= 0.1.10 , text- , time , time-manager , unix-compat >= 0.2 , vault@@ -227,11 +223,13 @@ , transformers if (os(linux) || os(freebsd) || os(darwin)) && flag(allow-sendfilefd)- Cpp-Options: -DSENDFILEFD- Build-Depends: unix+ Cpp-Options: -DSENDFILEFD if os(windows)- Cpp-Options: -DWINDOWS- Build-Depends: time+ Cpp-Options: -DWINDOWS+ Build-Depends: time+ else+ Build-Depends: unix+ Other-modules: Network.Wai.Handler.Warp.MultiMap if impl(ghc >= 8) Default-Extensions: Strict StrictData Default-Language: Haskell2010@@ -257,6 +255,7 @@ , http-types , network , network+ , recv , time-manager , unix-compat , unliftio