Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package ghc-recv for openSUSE:Factory checked in at 2026-11-06 19:49:43 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-recv (Old) and /work/SRC/openSUSE:Factory/.ghc-recv.new.3759290 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-recv" Fri Nov 6 19:49:43 2026 rev:4 rq:1395554 version:0.1.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-recv/ghc-recv.changes 2025-04-30 19:04:26.890490675 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-recv.new.3759290/ghc-recv.changes 2026-11-06 19:56:40.693920103 +0100 @@ -1,0 +2,19 @@ +Thu Oct 29 09:34:01 UTC 2026 - Peter Simons <[email protected]> + +- Update recv to version 0.1.3. + ## v0.1.3 + + * Adding `receiveWith`, a `receive` the caller can give up on through an + `STM` action: nothing is closed and no thread is interrupted to make it + return. Requires network 3.2.10. + +------------------------------------------------------------------- +Thu Aug 27 14:47:11 UTC 2026 - Peter Simons <[email protected]> + +- Update recv to version 0.1.2. + Upstream has edited the change log file since the last release in + a non-trivial way, i.e. they did more than just add a new entry + at the top. You can review the file at: + http://hackage.haskell.org/package/recv-0.1.2/src/ChangeLog.md + +------------------------------------------------------------------- Old: ---- recv-0.1.1.tar.gz New: ---- recv-0.1.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-recv.spec ++++++ --- /var/tmp/diff_new_pack.TsDcsl/_old 2026-11-06 19:56:41.814967030 +0100 +++ /var/tmp/diff_new_pack.TsDcsl/_new 2026-11-06 19:56:41.821967324 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-recv # -# Copyright (c) 2025 SUSE LLC +# Copyright (c) 2026 SUSE LLC # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -20,7 +20,7 @@ %global pkgver %{pkg_name}-%{version} %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.1.1 +Version: 0.1.3 Release: 0 Summary: Efficient network recv License: BSD-3-Clause @@ -34,6 +34,8 @@ BuildRequires: ghc-network-devel BuildRequires: ghc-network-prof BuildRequires: ghc-rpm-macros +BuildRequires: ghc-stm-devel +BuildRequires: ghc-stm-prof ExcludeArch: %{ix86} %if %{with tests} BuildRequires: ghc-hspec-devel ++++++ recv-0.1.1.tar.gz -> recv-0.1.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/ChangeLog.md new/recv-0.1.3/ChangeLog.md --- old/recv-0.1.1/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/ChangeLog.md 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,17 @@ # ChangeLog for "recv" +## v0.1.3 + +* Adding `receiveWith`, a `receive` the caller can give up on through an + `STM` action: nothing is closed and no thread is interrupted to make it + return. Requires network 3.2.10. + +## v0.1.2 + +* Providing `receiveNoWait` and `tryWithBufferPool`. + [#1107](https://github.com/yesodweb/wai/pull/1107) + ## v0.1.1 * Fixing the bug that the last chunk is skipped when the size is - insufficient [1031](https://github.com/yesodweb/wai/pull/1031) + insufficient [#1031](https://github.com/yesodweb/wai/pull/1031) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/Network/Socket/BufferPool/Buffer.hs new/recv-0.1.3/Network/Socket/BufferPool/Buffer.hs --- old/recv-0.1.1/Network/Socket/BufferPool/Buffer.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/Network/Socket/BufferPool/Buffer.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,14 @@ module Network.Socket.BufferPool.Buffer ( newBufferPool, withBufferPool, + tryWithBufferPool, + eitherWithBufferPool, mallocBS, copy, ) where import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) -import Data.ByteString.Unsafe (unsafeDrop, unsafeTake) import Data.IORef (newIORef, readIORef, writeIORef) import Foreign.ForeignPtr import Foreign.Marshal.Alloc (finalizerFree, mallocBytes) @@ -32,19 +33,63 @@ -- | Using a buffer pool. -- The second argument is a function which returns -- how many bytes are filled in the buffer. +-- This function should return non negative 'Int'. -- The buffer in the buffer pool is automatically managed. +-- +-- /Caveats of 'BufferPool' apply./ withBufferPool :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO ByteString -withBufferPool (BufferPool l h ref) f = do +withBufferPool pool@(BufferPool _ _ ref) f = do + (buf, consumed) <- applyBufferPool pool f + writeIORef ref $ BS.drop consumed buf + return $ BS.take consumed buf + +-- | L ike 'withBufferPool' for fillers that can decline to fill: +-- a negative return value from the filler leaves the pool untouched +-- and produces 'Nothing'. +-- +-- /Caveats of 'BufferPool' apply./ +tryWithBufferPool + :: BufferPool -> (Buffer -> BufSize -> IO Int) -> IO (Maybe ByteString) +tryWithBufferPool pool@(BufferPool _ _ ref) f = do + (buf, consumed) <- applyBufferPool pool f + if consumed < 0 + then do + writeIORef ref buf + return Nothing + else do + writeIORef ref $ BS.drop consumed buf + return $ Just $ BS.take consumed buf + +-- | Like 'withBufferPool' for fillers which can give up: 'Left' leaves +-- the pool untouched. +-- +-- /Caveats of 'BufferPool' apply./ +eitherWithBufferPool + :: BufferPool + -> (Buffer -> BufSize -> IO (Either a Int)) + -> IO (Either a ByteString) +eitherWithBufferPool pool@(BufferPool _ _ ref) f = do + (buf, r) <- applyBufferPool pool f + case r of + Left a -> do + writeIORef ref buf + return $ Left a + Right consumed -> do + writeIORef ref $ BS.drop consumed buf + return $ Right $ BS.take consumed buf + +applyBufferPool + :: BufferPool -> (Buffer -> BufSize -> IO r) -> IO (ByteString, r) +applyBufferPool (BufferPool l h ref) f = do buf0 <- readIORef ref buf <- if BS.length buf0 >= l then return buf0 else mallocBS h consumed <- withForeignBuffer buf f - writeIORef ref $ unsafeDrop consumed buf - return $ unsafeTake consumed buf + return (buf, consumed) -withForeignBuffer :: ByteString -> (Buffer -> BufSize -> IO Int) -> IO Int +withForeignBuffer :: ByteString -> (Buffer -> BufSize -> IO r) -> IO r withForeignBuffer (PS ps s l) f = withForeignPtr ps $ \p -> f (castPtr p `plusPtr` s) l {-# INLINE withForeignBuffer #-} diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/Network/Socket/BufferPool/Recv.hs new/recv-0.1.3/Network/Socket/BufferPool/Recv.hs --- old/recv-0.1.1/Network/Socket/BufferPool/Recv.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/Network/Socket/BufferPool/Recv.hs 2001-09-09 03:46:40.000000000 +0200 @@ -2,13 +2,16 @@ module Network.Socket.BufferPool.Recv ( receive, + receiveNoWait, + receiveWith, makeRecvN, ) where import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..), unsafeCreate) import Data.IORef -import Network.Socket (Socket, recvBuf) +import Control.Concurrent.STM (STM) +import Network.Socket (Socket, recvBuf, recvBufNoWait, recvBufWith) import Network.Socket.BufferPool.Buffer import Network.Socket.BufferPool.Types @@ -17,9 +20,41 @@ -- | The receiving function with a buffer pool. -- The buffer pool is automatically managed. +-- +-- /Caveats of 'BufferPool' apply./ receive :: Socket -> BufferPool -> Recv receive sock pool = withBufferPool pool $ \ptr size -> recvBuf sock ptr size +-- | Like 'receive' but never blocks and never involves the IO manager: +-- 'Nothing' means no data was available (or an error occurred, which a +-- subsequent blocking 'receive' will report properly). @Just \"\"@ is EOF. +-- +-- /Caveats of 'BufferPool' apply./ +receiveNoWait :: Socket -> BufferPool -> IO (Maybe ByteString) +receiveNoWait sock pool = tryWithBufferPool pool $ \ptr size -> + -- Both EAGAIN and real errors map to a negative result, deferring + -- to the blocking path so errors surface there with their errno + -- intact. + fromIntegral <$> recvBufNoWait sock ptr size + +-- | Like 'receive' but the caller can give up on it: whichever settles +-- first decides, 'Left' when the 'STM' action fires, 'Right' when data +-- arrives. Data already waiting is taken without blocking at all and +-- so wins over a caller which has given up, as a completed operation +-- does in 'Network.Socket.withReadable'; the give-up is read there +-- and nowhere else. +-- +-- Nothing is closed and no thread is interrupted to make this return. +-- +-- /Caveats of 'BufferPool' apply./ +receiveWith :: Socket -> BufferPool -> STM a -> IO (Either a ByteString) +receiveWith sock pool giveUp = do + early <- receiveNoWait sock pool + case early of + Just bs -> return $ Right bs + Nothing -> eitherWithBufferPool pool $ \ptr size -> + recvBufWith sock ptr size giveUp + ---------------------------------------------------------------- -- | This function returns a receiving function @@ -38,6 +73,8 @@ -- ("abc","") -- >>> tryRecvN "a" 3 =<< _iorefRecv ["b"] -- ("ab","") +-- +-- /The resulting 'RecvN' is designed to be used in one thread only./ makeRecvN :: ByteString -> Recv -> IO RecvN makeRecvN bs0 recv = do ref <- newIORef bs0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/Network/Socket/BufferPool/Types.hs new/recv-0.1.3/Network/Socket/BufferPool/Types.hs --- old/recv-0.1.1/Network/Socket/BufferPool/Types.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/Network/Socket/BufferPool/Types.hs 2001-09-09 03:46:40.000000000 +0200 @@ -12,6 +12,10 @@ type BufSize = Int -- | Type for read buffer pool. +-- +-- /Caveats: designed to be used by one thread only./ +-- /The buffer is not behind a lock, so using a 'BufferPool'/ +-- /in more than one thread might create race conditions./ data BufferPool = BufferPool { minBufSize :: Int -- ^ If the buffer is larger than or equal to this size, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/Network/Socket/BufferPool.hs new/recv-0.1.3/Network/Socket/BufferPool.hs --- old/recv-0.1.1/Network/Socket/BufferPool.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/Network/Socket/BufferPool.hs 2001-09-09 03:46:40.000000000 +0200 @@ -24,9 +24,12 @@ -- * Recv Recv, receive, + receiveNoWait, + receiveWith, BufferPool, newBufferPool, withBufferPool, + tryWithBufferPool, -- * RecvN RecvN, diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/recv.cabal new/recv-0.1.3/recv.cabal --- old/recv-0.1.1/recv.cabal 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/recv.cabal 2001-09-09 03:46:40.000000000 +0200 @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: recv -version: 0.1.1 +version: 0.1.3 license: BSD3 license-file: LICENSE maintainer: [email protected] @@ -25,7 +25,8 @@ build-depends: base >=4.12 && <5, bytestring >=0.9.1.4, - network >=3.1.0 + network >=3.2.10, + stm >=2.5 && <2.6 if impl(ghc >=8) default-extensions: Strict StrictData @@ -43,9 +44,11 @@ Network.Socket.BufferPool.Types default-language: Haskell2010 - ghc-options: -Wall + ghc-options: -Wall -threaded build-depends: base >=4.12 && <5, bytestring >=0.9.1.4, - network >=3.1.0, - hspec + network >=3.2.10, + stm >=2.5 && <2.6, + hspec, + recv diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/recv-0.1.1/test/BufferPoolSpec.hs new/recv-0.1.3/test/BufferPoolSpec.hs --- old/recv-0.1.1/test/BufferPoolSpec.hs 2001-09-09 03:46:40.000000000 +0200 +++ new/recv-0.1.3/test/BufferPoolSpec.hs 2001-09-09 03:46:40.000000000 +0200 @@ -1,13 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} module BufferPoolSpec where +import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) +import Control.Concurrent.STM +import Control.Monad (void) import qualified Data.ByteString as B import qualified Data.ByteString.Internal as B (ByteString (PS)) +import Data.IORef (newIORef, readIORef, writeIORef) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Utils (copyBytes) import Foreign.Ptr (plusPtr) +import Network.Socket +import qualified Network.Socket.ByteString as NSB import Network.Socket.BufferPool -import Test.Hspec (Spec, describe, hspec, it, shouldBe) +import Test.Hspec (Spec, describe, hspec, it, shouldBe, shouldReturn) main :: IO () main = hspec spec @@ -18,18 +26,112 @@ otherData = B.replicate 16384 0x77 spec :: Spec -spec = describe "withBufferPool" $ do - it "does not clobber buffers" $ do - pool <- newBufferPool 2048 16384 - -- 'pool' contains B.empty; prime it to contain a real buffer. - _ <- withBufferPool pool $ \_ _ -> 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 +spec = do + describe "withBufferPool" $ do + it "does not clobber buffers" $ do + pool <- newBufferPool 2048 16384 + -- 'pool' contains B.empty; prime it to contain a real buffer. + _ <- withBufferPool pool $ \_ _ -> 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 + + describe "tryWithBufferPool" $ do + it "returns the filled prefix when the filler fills" $ do + pool <- newBufferPool 2048 16384 + tryWithBufferPool pool (blitBuffer (B.take 10 wantData)) + `shouldReturn` Just (B.take 10 wantData) + + it "returns an empty ByteString when the filler consumes nothing" $ do + -- 'receiveNoWait' reports EOF this way, so it must not be 'Nothing'. + pool <- newBufferPool 2048 16384 + tryWithBufferPool pool (\_ _ -> return 0) `shouldReturn` Just B.empty + + it "returns Nothing when the filler declines" $ do + pool <- newBufferPool 2048 16384 + tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing + + it "keeps the leftover buffer when the filler declines" $ do + pool <- newBufferPool 2048 16384 + -- Consume 10000 of the 16384 bytes, leaving 6384 in the pool. + _ <- tryWithBufferPool pool $ \_ _ -> return 10000 + tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing + -- The declined call must neither consume, drop nor reallocate the + -- leftover: the next filler is offered exactly those 6384 bytes. + offered <- offeredSize pool + offered `shouldBe` 6384 + + it "does not corrupt buffered data across a decline" $ do + pool <- newBufferPool 2048 16384 + _ <- tryWithBufferPool pool $ \_ _ -> return 0 + tryWithBufferPool pool (\_ _ -> return (-1)) `shouldReturn` Nothing + tryWithBufferPool pool (blitBuffer wantData) + `shouldReturn` Just wantData + + describe "receiveWith" $ do + it "gives up while blocked, without closing the socket" $ do + withPair $ \_ srv pool -> do + stop <- newTVarIO False + done <- newEmptyMVar + void $ forkIO $ do + r <- receiveWith srv pool $ readTVar stop >>= check + putMVar done r + threadDelay 100000 + atomically $ writeTVar stop True + takeMVar done `shouldReturn` Left () + -- The socket is the caller's, and still theirs to read. + void $ getSocketName srv + + -- Data already there wins over a give-up, as it does in + -- withReadable: answering Left would leave it unread. + it "takes what is there even once the caller has given up" $ do + withPair $ \cli srv pool -> do + void $ NSB.send cli "unread" + threadDelay 100000 + gone <- newTVarIO True + receiveWith srv pool (readTVar gone >>= check) + `shouldReturn` Right "unread" + + it "reads nothing once the caller has given up and none is there" $ do + withPair $ \_cli srv pool -> do + gone <- newTVarIO True + receiveWith srv pool (readTVar gone >>= check) + `shouldReturn` Left () + + it "takes what is already there without waiting" $ do + withPair $ \cli srv pool -> do + void $ NSB.send cli "hello" + threadDelay 100000 + receiveWith srv pool (retry :: STM ()) `shouldReturn` Right "hello" + +-- A connected pair on the loopback, and a pool to receive with. +withPair :: (Socket -> Socket -> BufferPool -> IO a) -> IO a +withPair action = do + lsock <- socket AF_INET Stream defaultProtocol + setSocketOption lsock ReuseAddr 1 + bind lsock $ SockAddrInet 0 $ tupleToHostAddress (127, 0, 0, 1) + listen lsock 1 + port <- socketPort lsock + cli <- socket AF_INET Stream defaultProtocol + connect cli $ SockAddrInet port $ tupleToHostAddress (127, 0, 0, 1) + (srv, _) <- accept lsock + close lsock + pool <- newBufferPool 2048 16384 + r <- action cli srv pool + close cli + close srv + return r + +-- The 'BufSize' the pool offers to the next filler, leaving the pool as it was. +offeredSize :: BufferPool -> IO Int +offeredSize pool = do + ref <- newIORef 0 + _ <- tryWithBufferPool pool $ \_ size -> writeIORef ref size >> return 0 + readIORef ref -- Fill the Buffer with the contents of the ByteString and return the number of -- bytes written. To be used with 'withBufferPool'.
