Hello community, here is the log from the commit of package ghc-socket for openSUSE:Factory checked in at 2017-03-14 10:05:58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-socket (Old) and /work/SRC/openSUSE:Factory/.ghc-socket.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-socket" Tue Mar 14 10:05:58 2017 rev:3 rq:461682 version:0.7.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-socket/ghc-socket.changes 2016-11-10 13:25:56.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-socket.new/ghc-socket.changes 2017-03-14 10:05:59.249130996 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:20:20 UTC 2017 - [email protected] + +- Update to version 0.7.0.0 with cabal2obs. + +------------------------------------------------------------------- Old: ---- socket-0.6.1.0.tar.gz New: ---- socket-0.7.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-socket.spec ++++++ --- /var/tmp/diff_new_pack.HibV45/_old 2017-03-14 10:05:59.845046614 +0100 +++ /var/tmp/diff_new_pack.HibV45/_new 2017-03-14 10:05:59.845046614 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-socket # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name socket %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.6.1.0 +Version: 0.7.0.0 Release: 0 Summary: An extensible socket library License: MIT @@ -31,13 +31,15 @@ BuildRequires: ghc-rpm-macros BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} +BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-async-devel BuildRequires: ghc-tasty-devel BuildRequires: ghc-tasty-hunit-devel +BuildRequires: ghc-tasty-quickcheck-devel %endif %description -This library is a minimal cross platform interface for BSD style networking. +This library is a minimal cross-platform interface for BSD style networking. %package devel Summary: Haskell %{pkg_name} library development files @@ -74,6 +76,6 @@ %files devel -f %{name}-devel.files %defattr(-,root,root,-) -%doc CHANGELOG.md README.md +%doc CHANGELOG.md CONTRIBUTORS.txt README.md %changelog ++++++ socket-0.6.1.0.tar.gz -> socket-0.7.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/CHANGELOG.md new/socket-0.7.0.0/CHANGELOG.md --- old/socket-0.6.1.0/CHANGELOG.md 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/CHANGELOG.md 2016-11-13 23:30:20.000000000 +0100 @@ -1,3 +1,24 @@ +0.7.0.0 Lars Petersen <[email protected]> 2016-11-13 + + * Added function `sendAllLazy` and `sendAllBuilder`. Changed the signature and + semantics of `sendAll` (thus the major version bump). + + * The `MessageFlags` constructor is now exported (kudos to Shea Levy for noting + that this is necessary when writing extension libraries). + + * GHC 8 introduces a built-in alignment macro which is now used when present. + This prevents re-definition warnings. + + * Fixed implicit function declaration warning concerning accept4. + Defining `GNU_SOURCE` in the header file declares `accept4` when present + (see man accept4). + +0.6.2.0 Lars Petersen <[email protected]> 2016-08-15 + + * Added functions for constructing internet addresses without the need for IO + (`inetAddressToTuple`, `inetAddressFromTuple`, `inet6AddressToTuple`, + `inet6AddressFromTuple`) as proposed by Erik Rantapaa. + 0.6.1.0 Lars Petersen <[email protected]> 2016-08-11 * A potential race condition has been fixed (issue #18): `c_get_last_error` diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/CONTRIBUTORS.txt new/socket-0.7.0.0/CONTRIBUTORS.txt --- old/socket-0.6.1.0/CONTRIBUTORS.txt 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/CONTRIBUTORS.txt 2016-11-13 23:30:20.000000000 +0100 @@ -1,3 +1,4 @@ +Erik Rantapaa (issue #19) Mathieu Boespflug (issue #15) Ben Gamari (issue #10) Niklas Hambüchen (issue #9) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/platform/linux/cbits/hs_socket.c new/socket-0.7.0.0/platform/linux/cbits/hs_socket.c --- old/socket-0.6.1.0/platform/linux/cbits/hs_socket.c 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/platform/linux/cbits/hs_socket.c 2016-11-13 23:30:20.000000000 +0100 @@ -1,7 +1,7 @@ #include <hs_socket.h> int hs_socket (int domain, int type, int protocol, int *err) { -#ifdef SOCK_NONBLOCK +#ifdef __USE_GNU // On Linux, there is an optimized way to set a socket non-blocking int fd = socket(domain, type | SOCK_NONBLOCK, protocol); if (fd >= 0) { @@ -42,7 +42,7 @@ } int hs_accept (int sockfd, struct sockaddr *addr, int *addrlen, int *err) { -#ifdef SOCK_NONBLOCK +#ifdef __USE_GNU // On Linux, there is an optimized way to set a socket non-blocking int fd = accept4(sockfd, addr, addrlen, SOCK_NONBLOCK); if (fd >= 0) { diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/platform/linux/include/hs_socket.h new/socket-0.7.0.0/platform/linux/include/hs_socket.h --- old/socket-0.6.1.0/platform/linux/include/hs_socket.h 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/platform/linux/include/hs_socket.h 2016-11-13 23:30:20.000000000 +0100 @@ -1,3 +1,5 @@ +#define _GNU_SOURCE + #include <stdint.h> #include <unistd.h> #include <fcntl.h> diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/platform/linux/src/System/Socket/Internal/Platform.hsc new/socket-0.7.0.0/platform/linux/src/System/Socket/Internal/Platform.hsc --- old/socket-0.6.1.0/platform/linux/src/System/Socket/Internal/Platform.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/platform/linux/src/System/Socket/Internal/Platform.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -1,21 +1,12 @@ module System.Socket.Internal.Platform where -import Control.Applicative ((<$>)) -import Control.Exception -import Control.Monad (when, join) - +import Control.Monad (join) import Foreign.Ptr import Foreign.C.Types import Foreign.C.String -import Foreign.Storable -import Foreign.Marshal.Alloc - import GHC.Conc (threadWaitReadSTM, threadWaitWriteSTM, atomically) - import System.Posix.Types ( Fd(..) ) - import System.Socket.Internal.Message -import System.Socket.Internal.Exception #include "hs_socket.h" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/socket.cabal new/socket-0.7.0.0/socket.cabal --- old/socket-0.6.1.0/socket.cabal 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/socket.cabal 2016-11-13 23:30:20.000000000 +0100 @@ -1,8 +1,8 @@ name: socket -version: 0.6.1.0 +version: 0.7.0.0 synopsis: An extensible socket library. description: - This library is a minimal cross platform interface for + This library is a minimal cross-platform interface for BSD style networking. license: MIT @@ -70,8 +70,10 @@ test.hs build-depends: base >= 4.7 && < 5 - , tasty >= 0.11 + , tasty , tasty-hunit + , tasty-quickcheck + , QuickCheck >= 2.9 , async , bytestring , socket @@ -89,8 +91,10 @@ -threaded build-depends: base >= 4.7 && < 5 - , tasty >= 0.11 + , tasty , tasty-hunit + , tasty-quickcheck + , QuickCheck >= 2.9 , async , bytestring , socket diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket/Family/Inet.hsc new/socket-0.7.0.0/src/System/Socket/Family/Inet.hsc --- old/socket-0.6.1.0/src/System/Socket/Family/Inet.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket/Family/Inet.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -17,7 +17,12 @@ , InetPort -- ** SocketAddress Inet , SocketAddress (SocketAddressInet, inetAddress, inetPort) - -- * Special Addresses + -- * Custom addresses + -- ** inetAddressFromTuple + , inetAddressFromTuple + -- ** inetAddressToTuple + , inetAddressToTuple + -- * Special addresses -- ** inetAllHostsGroup , inetAllHostsGroup -- ** inetAny @@ -44,7 +49,10 @@ import System.Socket.Internal.Platform #include "hs_socket.h" + +#if __GLASGOW_HASKELL__ < 800 #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) +#endif -- | The [Internet Protocol version 4](https://en.wikipedia.org/wiki/IPv4). data Inet @@ -66,8 +74,11 @@ -- | To avoid errors with endianess it was decided to keep this type abstract. -- --- Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it --- exactly as found within an IP packet (big endian if you insist +-- Use `inetAddressFromTuple` and `inetAddressToTuple` for constructing and +-- deconstructing custom addresses. +-- +-- Hint: Use the `Foreign.Storable.Storable` instance. +-- It exposes it exactly as found within an IP packet (big endian if you insist -- on interpreting it as a number). -- -- Another hint: Use `System.Socket.getAddressInfo` for parsing and suppress @@ -82,6 +93,25 @@ newtype InetPort = InetPort Word16 deriving (Eq, Ord, Show, Num) +-- | Constructs a custom `InetAddress`. +-- +-- > inetAddressFromTuple (127,0,0,1) == inetLoopback +inetAddressFromTuple :: (Word8, Word8, Word8, Word8) -> InetAddress +inetAddressFromTuple (w0, w1, w2, w3) + = InetAddress $ foldl1' (\x y->x*256+y) [f w0, f w1, f w2, f w3] + where + f = fromIntegral + +-- | Deconstructs an `InetAddress`. +inetAddressToTuple :: InetAddress -> (Word8, Word8, Word8, Word8) +inetAddressToTuple (InetAddress a) + = (w0, w1, w2, w3) + where + w0 = fromIntegral $ rem (quot a $ 256*256*256) 256 + w1 = fromIntegral $ rem (quot a $ 256*256) 256 + w2 = fromIntegral $ rem (quot a $ 256) 256 + w3 = fromIntegral $ rem a $ 256 + -- | @0.0.0.0@ inetAny :: InetAddress inetAny = InetAddress $ 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket/Family/Inet6.hsc new/socket-0.7.0.0/src/System/Socket/Family/Inet6.hsc --- old/socket-0.6.1.0/src/System/Socket/Family/Inet6.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket/Family/Inet6.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -22,16 +22,22 @@ -- ** SocketAddress Inet6 , SocketAddress (SocketAddressInet6, inet6Address, inet6Port, inet6FlowInfo, inet6ScopeId) - -- * Special Addresses - -- ** inet6Any + -- * Custom addresses + -- ** inet6AddressFromTuple + , inet6AddressFromTuple + -- ** inet6AddressToTuple + , inet6AddressToTuple + -- * Special addresses + -- ** inet6Any , inet6Any - -- ** inet6Loopback + -- ** inet6Loopback , inet6Loopback - -- * Socket Options - -- ** V6Only + -- * Socket options + -- ** V6Only , V6Only (..) ) where +import Data.Bits ((.|.)) import Data.Word import Control.Applicative as A @@ -43,7 +49,10 @@ import System.Socket.Internal.Platform #include "hs_socket.h" + +#if __GLASGOW_HASKELL__ < 800 #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) +#endif -- | The [Internet Protocol version 4](https://en.wikipedia.org/wiki/IPv4). data Inet6 @@ -67,7 +76,10 @@ -- | To avoid errors with endianess it was decided to keep this type abstract. -- --- Hint: Use the `Foreign.Storable.Storable` instance if you really need to access. It exposes it +-- Use `inet6AddressFromTuple` and `inet6AddressToTuple` for constructing and +-- deconstructing custom addresses. +-- +-- Hint: Use the `Foreign.Storable.Storable` instance. It exposes it -- exactly as found within an IP packet (big endian if you insist -- on interpreting it as a number). -- @@ -91,6 +103,33 @@ newtype Inet6ScopeId = Inet6ScopeId Word32 deriving (Eq, Ord, Show, Num) +-- | Deconstructs an `Inet6Address`. +inet6AddressToTuple :: Inet6Address -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16) +inet6AddressToTuple (Inet6Address hb lb) = + (w0 hb, w1 hb, w2 hb, w3 hb, w0 lb, w1 lb, w2 lb, w3 lb) + where + w0, w1, w2, w3 :: Word64 -> Word16 + w0 x = fromIntegral $ rem (quot x $ 65536 * 65536 * 65536) 65536 + w1 x = fromIntegral $ rem (quot x $ 65536 * 65536) 65536 + w2 x = fromIntegral $ rem (quot x $ 65536) 65536 + w3 x = fromIntegral $ rem x 65536 + +-- | Constructs a custom `Inet6Address`. +-- +-- > inet6AddressFromTuple (0,0,0,0,0,0,0,1) == inet6Loopback +inet6AddressFromTuple :: (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16) -> Inet6Address +inet6AddressFromTuple (w0, w1, w2, w3, w4, w5, w6, w7) = + Inet6Address hb lb + where + hb = fromIntegral w0 * 65536 * 65536 * 65536 + .|. fromIntegral w1 * 65536 * 65536 + .|. fromIntegral w2 * 65536 + .|. fromIntegral w3 + lb = fromIntegral w4 * 65536 * 65536 * 65536 + .|. fromIntegral w5 * 65536 * 65536 + .|. fromIntegral w6 * 65536 + .|. fromIntegral w7 + -- | @::@ inet6Any :: Inet6Address inet6Any = Inet6Address 0 0 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket/Internal/AddressInfo.hsc new/socket-0.7.0.0/src/System/Socket/Internal/AddressInfo.hsc --- old/socket-0.6.1.0/src/System/Socket/Internal/AddressInfo.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket/Internal/AddressInfo.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -62,7 +62,10 @@ import System.Socket.Internal.Platform #include "hs_socket.h" + +#if __GLASGOW_HASKELL__ < 800 #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) +#endif ------------------------------------------------------------------------------- -- AddressInfo diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket/Type/Stream.hsc new/socket-0.7.0.0/src/System/Socket/Type/Stream.hsc --- old/socket-0.6.1.0/src/System/Socket/Type/Stream.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket/Type/Stream.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -10,21 +10,33 @@ module System.Socket.Type.Stream ( -- * Stream Stream - -- * Convenience Operations - -- ** sendAll, receiveAll + -- ** Specialized send operations + -- *** sendAll , sendAll + -- *** sendAllLazy + , sendAllLazy + -- *** sendAllBuilder + , sendAllBuilder + -- ** Specialized receive operations + -- *** receiveAll , receiveAll ) where +import Control.Exception (throwIO) import Control.Monad (when) import Data.Int +import Data.Word import Data.Monoid +import Foreign.Ptr +import Foreign.Marshal.Alloc import qualified Data.ByteString as BS +import qualified Data.ByteString.Unsafe as BS import qualified Data.ByteString.Builder as BB -import qualified Data.ByteString.Builder.Extra as BB +import qualified Data.ByteString.Builder.Internal as BB import qualified Data.ByteString.Lazy as LBS import System.Socket +import System.Socket.Unsafe #include "hs_socket.h" @@ -33,21 +45,84 @@ instance Type Stream where typeNumber _ = (#const SOCK_STREAM) -------------------------------------------------------------------------------- --- Convenience Operations -------------------------------------------------------------------------------- - --- | Like `send`, but operates on lazy `Data.ByteString.Lazy.ByteString`s and --- continues until all data has been sent or an exception occured. -sendAll ::Socket f Stream p -> LBS.ByteString -> MessageFlags -> IO () -sendAll s lbs flags = - LBS.foldlChunks - (\x bs-> x >> sendAll' bs - ) (return ()) lbs +-- | Sends a whole `BS.ByteString` with as many system calls as necessary +-- and returns the bytes sent (in this case just the `BS.ByteString`s +-- `BS.length`). +sendAll :: Socket f Stream p -> BS.ByteString -> MessageFlags -> IO Int +sendAll s bs flags = do + BS.unsafeUseAsCStringLen bs (uncurry sendAllPtr) + return (BS.length bs) where - sendAll' bs = do - sent <- send s bs flags - when (sent < BS.length bs) $ sendAll' (BS.drop sent bs) + sendAllPtr :: Ptr a -> Int -> IO () + sendAllPtr ptr len = do + sent <- fromIntegral `fmap` unsafeSend s ptr (fromIntegral len) flags + when (sent < len) $ sendAllPtr (plusPtr ptr sent) (len - sent) + +-- | Like `sendAll`, but operates on lazy `Data.ByteString.Lazy.ByteString`s. +-- +-- It uses `sendAll` internally to send all chunks sequentially. The lock on +-- the socket is acquired for each chunk separately, so the socket can be read +-- from in an interleaving fashion. +sendAllLazy :: Socket f Stream p -> LBS.ByteString -> MessageFlags -> IO Int64 +sendAllLazy s lbs flags = + LBS.foldlChunks f (return 0) lbs + where + f action bs = do + sent <- action + sent' <- fromIntegral `fmap` sendAll s bs flags + return $! sent + sent' + +-- | Sends a whole `BB.Builder` without allocating `BS.ByteString`s. +-- If performance is an issue, this operation should be preferred over all +-- other solutions for sending stream data. +-- +-- The operation `alloca`tes a single buffer of the given size on entry and +-- reuses this buffer until the whole `BB.Builder` has been sent. +-- The count of all bytes sent is returned as there is no other efficient +-- way to determine a `BB.Builder`s size without actually building it. +sendAllBuilder :: Socket f Stream p -> Int -> BB.Builder -> MessageFlags -> IO Int64 +sendAllBuilder s bufsize builder flags = do + allocaBytes bufsize g + where + g ptr = writeStep (BB.runPut $ BB.putBuilder builder) 0 + where + bufferRange :: BB.BufferRange + bufferRange = + BB.BufferRange ptr (plusPtr ptr bufsize) + writeStep :: BB.BuildStep a -> Int64 -> IO Int64 + writeStep step alreadySent = + BB.fillWithBuildStep step whenDone whenFull whenChunk bufferRange + where + whenDone ptrToNextFreeByte _ + | len > 0 = do + sendAllPtr ptr len + return $! alreadySent + fromIntegral len + | otherwise = + return alreadySent + where + len = minusPtr ptrToNextFreeByte ptr + whenFull ptrToNextFreeByte minBytesRequired nextStep + | minBytesRequired > bufsize = + throwIO eNoBufferSpace + | otherwise = do + sendAllPtr ptr len + writeStep nextStep $! alreadySent + fromIntegral len + where + len = minusPtr ptrToNextFreeByte ptr + whenChunk ptrToNextFreeByte bs nextStep = do + sendAllPtr ptr len + if BS.null bs + then + writeStep nextStep $! alreadySent + fromIntegral len + else do + bsLen <- sendAll s bs flags + writeStep nextStep $! alreadySent + fromIntegral (len + bsLen) + where + len = minusPtr ptrToNextFreeByte ptr + sendAllPtr :: Ptr Word8 -> Int -> IO () + sendAllPtr ptr len = do + sent <- fromIntegral `fmap` unsafeSend s ptr (fromIntegral len) flags + when (sent < len) $ sendAllPtr (plusPtr ptr sent) (len - sent) -- | Like `receive`, but operates on lazy `Data.ByteString.Lazy.ByteString`s and -- continues until either an empty part has been received (peer closed diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket/Unsafe.hsc new/socket-0.7.0.0/src/System/Socket/Unsafe.hsc --- old/socket-0.6.1.0/src/System/Socket/Unsafe.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket/Unsafe.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -34,8 +34,6 @@ , tryWaitRetryLoop ) where -import Data.Function - import Control.Applicative ((<$>)) import Control.Monad import Control.Exception @@ -55,7 +53,7 @@ #include "hs_socket.h" -unsafeSend :: Socket a t p -> Ptr a -> CSize -> MessageFlags -> IO CInt +unsafeSend :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt unsafeSend s bufPtr bufSize flags = do tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_send fd bufPtr bufSize flags ) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/src/System/Socket.hsc new/socket-0.7.0.0/src/System/Socket.hsc --- old/socket-0.6.1.0/src/System/Socket.hsc 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/src/System/Socket.hsc 2016-11-13 23:30:20.000000000 +0100 @@ -87,7 +87,7 @@ , HasNameInfo (..) -- * Flags -- ** MessageFlags - , MessageFlags () + , MessageFlags (..) , msgEndOfRecord , msgNoSignal , msgOutOfBand diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/socket-0.6.1.0/test/test.hs new/socket-0.7.0.0/test/test.hs --- old/socket-0.6.1.0/test/test.hs 2016-08-11 15:43:52.000000000 +0200 +++ new/socket-0.7.0.0/test/test.hs 2016-11-13 23:30:20.000000000 +0100 @@ -1,38 +1,44 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Control.Concurrent ( threadDelay ) -import Control.Concurrent.Async ( async, race, poll, cancel, concurrently, wait ) -import Control.Exception ( try, bracket, throwIO, catch ) -import Control.Monad ( when, unless, void ) - -import Prelude hiding ( head ) - -import Data.Maybe ( isJust ) -import Data.Monoid ( mempty ) -import Data.Int ( Int64 ) -import qualified Data.ByteString.Lazy as LBS - -import Test.Tasty -import Test.Tasty.HUnit - -import System.Socket -import System.Socket.Family.Inet -import System.Socket.Family.Inet6 -import System.Socket.Type.Stream -import System.Socket.Type.Datagram -import System.Socket.Protocol.TCP -import System.Socket.Protocol.UDP +import Control.Concurrent (threadDelay) +import Control.Concurrent.Async (async, cancel, concurrently, poll, + race, wait) +import Control.Exception (bracket, catch, throwIO, try) +import Control.Monad (unless, void, when) +import qualified Data.ByteString.Builder as BB +import qualified Data.ByteString.Lazy as LBS +import Data.Int (Int64) +import Data.Maybe (isJust) +import Data.Monoid (mempty, mappend) +import Prelude hiding (head) +import System.Socket +import System.Socket.Family.Inet +import System.Socket.Family.Inet6 +import System.Socket.Protocol.TCP +import System.Socket.Protocol.UDP +import System.Socket.Type.Datagram +import System.Socket.Type.Stream +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck as QC main :: IO () -main = defaultMain $ testGroup "System.Socket" - [ group00 - , group01 - , group02 - , group03 - , group07 - , group80 - , group99 ] +main = defaultMain $ testGroup "socket" + [ testGroup "System.Socket" + [ group00 + , group01 + , group02 + , group03 + , group07 + , group80 + , group99 + ] + , testGroup "System.Socket.Inet" [ + group200 + , group201 + ] + ] port :: InetPort port = 39000 @@ -63,7 +69,7 @@ case p of Just (Left ex) -> assertFailure "unexpected exception" Just (Right _) -> assertFailure "unexpected connect" - Nothing -> void $ cancel a + Nothing -> void $ cancel a ] ] @@ -159,7 +165,7 @@ setSocketOption sock (ReuseAddress True) listen sock 5 `catch` \e-> case e of _ | e == eOperationNotSupported -> return () - _ -> assertFailure "expected eOperationNotSupported" + _ -> assertFailure "expected eOperationNotSupported" ] , testGroup "Inet/Stream/TCP" [ testCase "listen on bound socket" $ bracket @@ -259,7 +265,35 @@ group07 :: TestTree group07 = testGroup "sendAll/receiveAll" [ testGroup "Inet/Stream/TCP" - [ testCase "send and receive a 128MB chunk" $ bracket + [ testCase "sendAll and receiveAll a 128MB chunk" $ bracket + ( do + server <- socket :: IO (Socket Inet Stream TCP) + client <- socket :: IO (Socket Inet Stream TCP) + return (server, client) + ) + ( \(server,client)-> do + close server + close client + ) + ( \(server,client)-> do + let addr = SocketAddressInet inetLoopback port + let msgSize = 128*1024*1024 + 1 :: Int64 + let msg = LBS.replicate msgSize 23 + setSocketOption server (ReuseAddress True) + bind server addr + listen server 5 + serverRecv <- async $ do + (peerSock, peerAddr) <- accept server + receiveAll peerSock msgSize mempty + threadDelay 100000 + connect client addr + sent <- sendAll client (LBS.toStrict msg) mempty + close client + msgReceived <- wait serverRecv + when (fromIntegral sent /= LBS.length msg) (assertFailure "sendAll reported wrong size.") + when (msgReceived /= msg) (assertFailure "Received message was bogus.") + ) + , testCase "sendAllLazy and receiveAll a 128MB chunk" $ bracket ( do server <- socket :: IO (Socket Inet Stream TCP) client <- socket :: IO (Socket Inet Stream TCP) @@ -281,9 +315,38 @@ receiveAll peerSock msgSize mempty threadDelay 100000 connect client addr - sendAll client msg mempty + sent <- sendAllLazy client msg mempty close client msgReceived <- wait serverRecv + when (sent /= LBS.length msg) (assertFailure "sendAllLazy reported wrong size.") + when (msgReceived /= msg) (assertFailure "Received message was bogus.") + ) + , testCase "sendAllBuilder and receiveAll a 128MB chunk" $ bracket + ( do + server <- socket :: IO (Socket Inet Stream TCP) + client <- socket :: IO (Socket Inet Stream TCP) + return (server, client) + ) + ( \(server,client)-> do + close server + close client + ) + ( \(server,client)-> do + let addr = SocketAddressInet inetLoopback port + let msgSize = 128*1024*1024 + 1 :: Int64 + let msg = LBS.replicate msgSize 23 + setSocketOption server (ReuseAddress True) + bind server addr + listen server 5 + serverRecv <- async $ do + (peerSock, peerAddr) <- accept server + receiveAll peerSock msgSize mempty + threadDelay 100000 + connect client addr + sent <- sendAllBuilder client 512 (foldr (\bs-> (BB.byteString bs `mappend`)) mempty $ LBS.toChunks msg) mempty + close client + msgReceived <- wait serverRecv + when (sent /= LBS.length msg) (assertFailure "sendAllBuilder reported wrong size.") when (msgReceived /= msg) (assertFailure "Received message was bogus.") ) ] @@ -303,6 +366,7 @@ ) ( \(server,client)-> do setSocketOption server (V6Only True) + setSocketOption server (ReuseAddress True) bind server (SocketAddressInet6 inet6Any port6 0 0) threadDelay 1000000 -- wait for the listening socket being set up sendTo client "PING" mempty (SocketAddressInet inetLoopback port) @@ -310,7 +374,7 @@ ( void $ receiveFrom server 4096 mempty ) ( threadDelay 1000000 ) case eith of - Left () -> assertFailure "expected timeout" + Left () -> assertFailure "expected timeout" Right () -> return () -- timeout is the expected behaviour ) , testCase "absent" $ bracket @@ -325,6 +389,7 @@ ) ( \(server,client)-> do setSocketOption server (V6Only False) + setSocketOption server (ReuseAddress True) bind server (SocketAddressInet6 inet6Any port6 0 0) threadDelay 1000000 -- wait for the listening socket being set up sendTo client "PING" mempty (SocketAddressInet inetLoopback port) @@ -332,7 +397,7 @@ ( void $ receiveFrom server 4096 mempty ) ( threadDelay 1000000 ) case eith of - Left () -> return () + Left () -> return () Right () -> assertFailure "expected packet" ) ] @@ -356,6 +421,26 @@ , testCase "getAddrInfo \"\" \"\"" $ void (getAddressInfo Nothing Nothing mempty :: IO [AddressInfo Inet Stream TCP]) `catch` \e-> case e of _ | e == eaiNoName -> return () - _ -> assertFailure "expected eaiNoName" + _ -> assertFailure "expected eaiNoName" + + ] + +group200 :: TestTree +group200 = testGroup "System.Socket.Family.Inet" [ + + testCase "inetAddressFromTuple (127,0,0,1) == inetLoopback" $ + assertEqual "" ( inetAddressFromTuple (127,0,0,1) ) inetLoopback + + , QC.testProperty "inetAddressToTuple (inetAddressFromTuple x) == x" $ \x-> + inetAddressToTuple (inetAddressFromTuple x) === x + ] + +group201 :: TestTree +group201 = testGroup "System.Socket.Family.Inet6" [ + + testCase "inet6AddressFromTuple (0,0,0,0,0,0,0,1) == inet6Loopback" $ + assertEqual "" ( inet6AddressFromTuple (0,0,0,0,0,0,0,1) ) inet6Loopback + , QC.testProperty "inet6AddressToTuple (inet6AddressFromTuple x) == x" $ \x-> + inet6AddressToTuple (inet6AddressFromTuple x) === x ]
