socket 0.7.0.0 → 0.8.3.0
raw patch · 29 files changed
Files
- CHANGELOG.md +63/−0
- CONTRIBUTORS.txt +6/−0
- README.md +14/−16
- platform/linux/cbits/hs_socket.c +6/−0
- platform/linux/include/hs_socket.h +3/−0
- platform/linux/src/System/Socket/Internal/Platform.hsc +51/−22
- platform/win32/cbits/hs_socket.c +8/−4
- platform/win32/include/hs_socket.h +1/−2
- platform/win32/src/System/Socket/Internal/Platform.hsc +62/−24
- socket.cabal +4/−3
- src/System/Socket.hsc +150/−121
- src/System/Socket/Family/Inet.hsc +13/−15
- src/System/Socket/Family/Inet6.hsc +19/−20
- src/System/Socket/Internal/AddressInfo.hsc +72/−62
- src/System/Socket/Internal/Exception.hsc +138/−39
- src/System/Socket/Internal/Message.hsc +36/−9
- src/System/Socket/Internal/Socket.hs +96/−0
- src/System/Socket/Internal/Socket.hsc +0/−128
- src/System/Socket/Internal/SocketOption.hsc +115/−0
- src/System/Socket/Protocol/Default.hsc +19/−0
- src/System/Socket/Protocol/TCP.hsc +18/−2
- src/System/Socket/Protocol/UDP.hsc +2/−2
- src/System/Socket/Type/Datagram.hsc +1/−1
- src/System/Socket/Type/Raw.hsc +1/−1
- src/System/Socket/Type/SequentialPacket.hsc +1/−1
- src/System/Socket/Type/Stream.hsc +5/−3
- src/System/Socket/Unsafe.hs +102/−0
- src/System/Socket/Unsafe.hsc +0/−92
- test/test.hs +56/−14
CHANGELOG.md view
@@ -1,3 +1,66 @@+0.8.3.0 Lars Petersen <info@lars-petersen.net> 2020-06-29++ * Updates Stack LTS to 16.3++0.8.2.0 Lars Petersen <info@lars-petersen.net> 2018-10-31++ * Issue 61: Fixed unexpected `IOError` bubbling up from `threadWaitSTM`.+ * Added message flag `msgPeek` (MSG_PEEK).++0.8.1.0 Lars Petersen <info@lars-petersen.net> 2018-08-13++ * Issue 51: Add a `getAddress` operation for getting the local socket address.+ * Marked `System.Socket.Type.Stream.receiveAll` as deprecated.+ This is a preparation for a name reuse in upcoming 0.9.0.0.+ * Removed dead code (`Message` type).+ * Added error code `ePermissionDenied`.++0.8.0.1 Lars Petersen <info@lars-petersen.net> 2017-02-25++ * Issue 47: Fixed haddock documentation. + * Issue 46: Export `KeepAlive` socket option in the main module.++0.8.0.0 Lars Petersen <info@lars-petersen.net> 2017-02-25++ * Issue 26: Show instances for `SocketException` and `AddressInfoException`+ no longer use `strerror()` and `gai_strerror()`, but simply show the name+ of the error code. Linking to `gai_strerror()` was problematic on Windows+ and `strerror()` was not thread-safe on Linux.++ * Issue 38: Added SO_KEEPALIVE as `System.Socket.KeepAlive`.++ * Issue 37: Added TCP_NODELAY as `System.Socket.Protocol.TCP.NoDelay`.++ * Issue 40: Changed allocation function to malloPlainForeignPtr.+ This mechanism used in the ByteString library is heavily optimised and+ 2 - 2.5 times faster than the previous implementation.+ See https://github.com/lpeterse/haskell-socket/pull/40 for details.++ * Issue 31: Added a `Default` protocol type.++ * Issue 27: Fixed a memory leak that manifested when interrupting threads+ waiting on socket events.++ * Issue 25: The `awaitEvent: invalid argument` was caused by the forked-off+ thread in `threadWaitRead`. The new code introduced by the changes caused+ by issue 27 catches and swallows this exception in a sane way.++ * Renamed `unsafeSocketWaitRead/Write/Connected` to `waitRead/Write/Connected`+ as these operations are not really unsafe, just internal. The operation+ signatures changed due to issue 27. Also, documented Windows specific+ implementation details.++ * The `connect` operation does no longer hold the lock on the socket while+ waiting for connection establishment.++ * Refactored and adapted the `accept` operation for changes caused by issue 27.+ Operation semantics shouldn't have changed.++ * Made `SocketAddress` an associated data family and added a+ `Storable (SocketAddress f)` constraint to the `Family` class. This allows+ omitting the `Storable` in socket operations (`Family` suffices now). It+ should be compatible with all existing code and not require any changes.+ 0.7.0.0 Lars Petersen <info@lars-petersen.net> 2016-11-13 * Added function `sendAllLazy` and `sendAllBuilder`. Changed the signature and
CONTRIBUTORS.txt view
@@ -1,3 +1,8 @@+Olivier Nicole (issue #15)+Vyacheslav Hashov (issues #37, #38, #40, #41, #42)+Alexander Vershilov (fixed bug in GHC upstream)+Antom @SX91 (reported and helped with #27)+Lukas Epple (small fix in documentation) Erik Rantapaa (issue #19) Mathieu Boespflug (issue #15) Ben Gamari (issue #10)@@ -5,3 +10,4 @@ Michael Fox (reported issue #7) Bryan O'Sullivan (legitimately criticised the bizarre naming) Alex Högy (reported the MSG_NOSIGNAL issue on OSX)+Lars Petersen
README.md view
@@ -4,11 +4,12 @@ [![Available on Hackage][badge-hackage]][hackage] [![License MIT][badge-license]][license] [![Build Status][badge-travis]][travis]+[![AppVeyor][badge-appveyor]][appveyor] ### Motivation -This library aims to expose a minimal and cross platform interface for-POSIX compliant networking code.+This library aims to expose a minimal and cross-platform interface for+BSD style networking code. ### Implementation Philosophy @@ -39,7 +40,7 @@ The original [network](https://hackage.haskell.org/package/network) library suffers from this, too. For example, connection attempts are non-interruptible etc. The approach taken to circumvent this in this library is to poll the-non-blocking sockets with increasing delay. This guarantees non-interruptability+non-blocking sockets with increasing delay. This guarantees interruptibility and fairness between different threads. It allows for decent throughput while also keeping CPU consumption on a moderate level if a socket has not seen events for a longer period of time (maximum of 1 second delay after 20@@ -51,8 +52,9 @@ This workaround may be removed if someone is willing to sacrifice to improve the IO manager on Windows. -Each release is manually tested on a Windows 10 virtual machine with the-latest Haskell Platform (64bit).+Each commit and release is automatically tested with+[AppVeyor](https://ci.appveyor.com/project/lpeterse/haskell-socket) continuous+integration. #### MacOS @@ -69,19 +71,15 @@ The project uses [tasty](http://documentup.com/feuerbach/tasty) for testing. -There are two test suites: `default` and `threaded` which are using the same-code. Only difference is that one is compiled against GHC's single threaded RTS-and the other against the multi-threaded one. Run `cabal test` to run both-in sequence.--In order to see details and colored output you may also want to try--```bash-ghc --make test/test.hs && ./test/test-```+There are two test suites: `default` and `threaded` which share the same+code. The only difference is that one is compiled against GHC's single threaded+RTS and the other against the multi-threaded one. Run `cabal test` or `stack test`+to execute both in sequence. -[badge-travis]: https://img.shields.io/travis/lpeterse/haskell-socket.svg+[badge-travis]: https://img.shields.io/travis/lpeterse/haskell-socket.svg?label=Linux%20build [travis]: https://travis-ci.org/lpeterse/haskell-socket+[badge-appveyor]: https://img.shields.io/appveyor/ci/lpeterse/haskell-socket.svg?label=Windows%20build+[appveyor]: https://ci.appveyor.com/project/lpeterse/haskell-socket [badge-hackage]: https://img.shields.io/hackage/v/socket.svg?dummy [hackage]: https://hackage.haskell.org/package/socket [badge-license]: https://img.shields.io/badge/license-MIT-green.svg?dummy
platform/linux/cbits/hs_socket.c view
@@ -105,3 +105,9 @@ *err = errno; return i; }++int hs_getsockname(int fd, struct sockaddr *addr, socklen_t *addrlen, int *err) {+ int i = getsockname(fd, addr, addrlen);+ *err = errno;+ return i;+}
platform/linux/include/hs_socket.h view
@@ -1,6 +1,7 @@ #define _GNU_SOURCE #include <stdint.h>+#include <string.h> #include <unistd.h> #include <fcntl.h> #include <errno.h>@@ -9,6 +10,7 @@ #include "sys/socket.h" #include "sys/un.h" #include "netinet/in.h"+#include <netinet/tcp.h> #include "netdb.h" int hs_socket (int domain, int type, int protocol, int *err);@@ -31,6 +33,7 @@ #define SEAGAIN EAGAIN #define SEWOULDBLOCK EWOULDBLOCK #define SEBADF EBADF+#define SEACCES EACCES #define SEINVAL EINVAL #define SEINPROGRESS EINPROGRESS #define SEPROTONOSUPPORT EPROTONOSUPPORT
platform/linux/src/System/Socket/Internal/Platform.hsc view
@@ -1,37 +1,63 @@-module System.Socket.Internal.Platform where+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Internal.Platform+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+--------------------------------------------------------------------------------+module System.Socket.Internal.Platform+ ( waitRead, waitWrite, waitConnected, c_socket, c_close, c_connect,+ c_accept, c_bind, c_listen, c_recv, c_recvfrom, c_send, c_sendto,+ c_freeaddrinfo, c_getaddrinfo, c_getnameinfo, c_memset, c_gai_strerror,+ c_setsockopt, c_getsockopt, c_getsockname) where -import Control.Monad (join)+import Control.Monad ( when, unless )+import Control.Concurrent.MVar+import Control.Concurrent ( threadWaitRead, threadWaitWrite,+ threadWaitReadSTM, threadWaitWriteSTM,+ forkIO, rtsSupportsBoundThreads, killThread )+import Control.Exception ( bracketOnError, throwIO, catch, SomeException(..) ) import Foreign.Ptr import Foreign.C.Types import Foreign.C.String-import GHC.Conc (threadWaitReadSTM, threadWaitWriteSTM, atomically)+import GHC.Conc.Sync ( STM, atomically ) import System.Posix.Types ( Fd(..) )+import System.Socket.Internal.Socket import System.Socket.Internal.Message+import System.Socket.Internal.Exception #include "hs_socket.h" -unsafeSocketWaitWrite :: Fd -> Int -> IO (IO ())-unsafeSocketWaitWrite fd _ = do- threadWaitWriteSTM fd >>= return . atomically . fst+waitRead :: Socket f t p -> Int -> IO ()+waitRead s _ = wait s threadWaitRead threadWaitReadSTM --- | Blocks until a socket should be tried for reading.------ > safeSocketWaitRead = do--- > wait <- withMVar msock $ \sock-> do--- > -- Register while holding a lock on the socket descriptor.--- > unsafeSocketWaitRead sock 0--- > -- Do the waiting without keeping the socket descriptor locked.--- > wait-unsafeSocketWaitRead :: Fd -- ^ Socket descriptor- -> Int -- ^ How many times has it been tried unsuccessfully so far? (currently only relevant on Windows)- -> IO (IO ()) -- ^ The outer action registers the waiting, the inner does the actual wait.-unsafeSocketWaitRead fd _ = do- threadWaitReadSTM fd >>= return . atomically . fst+waitWrite :: Socket f t p -> Int -> IO ()+waitWrite s _ = wait s threadWaitWrite threadWaitWriteSTM -unsafeSocketWaitConnected :: Fd -> IO ()-unsafeSocketWaitConnected fd = do- join $ unsafeSocketWaitWrite fd 0+waitConnected :: Socket f t p -> IO ()+waitConnected = flip waitWrite 0 +wait :: Socket f t p -> (Fd -> IO ()) -> (Fd -> IO (STM (), IO ())) -> IO ()+wait (Socket mfd) threadWait threadWaitSTM+ | rtsSupportsBoundThreads = bracketOnError+ ( withMVar mfd $ \fd -> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ threadWaitSTM fd+ )+ snd ( atomically . fst ) `catch` (const (throwIO eBadFileDescriptor) :: IOError -> IO ())+ | otherwise = do+ m <- newEmptyMVar+ bracketOnError+ ( withMVar mfd $ \fd-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ forkIO $ catch+ ( threadWait fd >> putMVar m True )+ ( \(SomeException _)-> putMVar m False )+ ) killThread+ ( const $ takeMVar m >>= flip unless (throwIO eBadFileDescriptor) )+ type CSSize = CInt @@ -85,3 +111,6 @@ foreign import ccall unsafe "gai_strerror" c_gai_strerror :: CInt -> IO CString++foreign import ccall unsafe "hs_getsockname"+ c_getsockname :: Fd -> Ptr a -> Ptr CInt -> Ptr CInt -> IO CInt
platform/win32/cbits/hs_socket.c view
@@ -167,10 +167,6 @@ return i; }; -const char *hs_gai_strerror(int errcode) {- return gai_strerror(errcode);-};- int hs_getaddrinfo(const char *node, const char *service, const struct addrinfo *hints, struct addrinfo **res) {@@ -193,3 +189,11 @@ freeaddrinfo(res); return; };++int hs_getsockname(int fd, struct sockaddr *addr, socklen_t *addrlen, int *err) {+ int i = getsockname(fd, addr, addrlen);+ if (i < 0) {+ *err = WSAGetLastError();+ }+ return i;+}
platform/win32/include/hs_socket.h view
@@ -103,13 +103,12 @@ void hs_freeaddrinfo(struct addrinfo *res); -const char *hs_gai_strerror(int errcode);- #define SEOK 0 #define SEINTR WSAEINTR #define SEAGAIN WSATRY_AGAIN #define SEWOULDBLOCK WSAEWOULDBLOCK #define SEBADF WSAEBADF+#define SEACCES WSAEACCES #define SEINVAL WSAEINVAL #define SEINPROGRESS WSAEINPROGRESS #define SEPROTONOSUPPORT WSAEPROTONOSUPPORT
platform/win32/src/System/Socket/Internal/Platform.hsc view
@@ -1,45 +1,83 @@+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Internal.Platform+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+-------------------------------------------------------------------------------- module System.Socket.Internal.Platform where import Control.Concurrent ( threadDelay )-import Control.Concurrent.MVar ( MVar, withMVar )+import Control.Concurrent.MVar ( withMVar ) import Control.Exception ( throwIO ) import Control.Monad ( when )- import Data.Bits- import Foreign.Ptr import Foreign.C.Types import Foreign.C.String import Foreign.Storable import Foreign.Marshal- import System.Posix.Types ( Fd(..) )-+import System.Socket.Internal.Socket import System.Socket.Internal.Message import System.Socket.Internal.Exception -unsafeSocketWaitWrite :: Fd -> Int -> IO (IO ())-unsafeSocketWaitWrite _ iteration = do- return (threadDelay $ 1 `shiftL` min iteration 20)+-- | Wait until the socket becomes readable (Windows specific version).+--+-- This operation does not actually do anything with the socket. It just+-- calls `threadDelay` with a delay exponentially increasing in the second+-- parameter (0 => 1μs, 20 or greater => 1s). When the operation returns,+-- the socket shall be tried to read from - it does not imply that there is+-- actually data to read and it might be necessary to wait again!+--+-- On Windows, socket descriptors don't behave like file+-- descriptors, but require a specific select mechanism. Unfortunately,+-- this is not (yet) implemented in GHC's RTS and it cannot be called from here+-- as it would block.+--+-- In practice, this means that your application may suffer from reduced+-- responsibility (up to 1s in case the socket has not seen events for 20+-- cycles). Usually, this is only the case for the first of several sequential+-- reads from a socket. Subsequent reads will be executed without delay until+-- there is no more data to read, so it is still possible to achieve high+-- throughput. The central achievement of this approach is that all socket+-- operations offered by the library are interruptable and no special+-- considerations (apart the from one above) apply when running socket code on+-- Windows.+waitRead :: Socket f t p -> Int -> IO ()+waitRead _ iteration =+ threadDelay $ 1 `shiftL` min iteration 20 -unsafeSocketWaitRead :: Fd -> Int -> IO (IO ())-unsafeSocketWaitRead _ iteration = do- return (threadDelay $ 1 `shiftL` min iteration 20)+-- | Wait until the socket becomes writable (Windows specific version).+--+-- See `waitRead` for technical details.+waitWrite :: Socket f t p -> Int -> IO ()+waitWrite _ iteration =+ threadDelay $ 1 `shiftL` min iteration 20 -unsafeSocketWaitConnected :: Fd -> IO ()-unsafeSocketWaitConnected fd =+-- | Wait until the socket is confirmed to be connected (Windows specific version).+--+-- This operation uses an exponential-backoff algorithm as described in+-- `waitRead`. On each iteration `select` is called with a minmal timeout+-- to poll the connection status. This approach keeps the operation interruptable.+waitConnected :: Socket f t p -> IO ()+waitConnected (Socket mfd) = alloca $ \errPtr-> loop errPtr 0 where loop errPtr iteration = do- i <- c_connect_status fd errPtr- when (i /= 0) $ case i of- 1 -> do- -- Wait with exponential backoff.- threadDelay $ 1 `shiftL` min iteration 20- -- Try again.- loop errPtr $! iteration + 1- _ -> do- SocketException <$> peek errPtr >>= throwIO+ i <- withMVar mfd $ \fd-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ c_connect_status fd errPtr+ case i of+ 0 -> return ()+ 1 -> do+ -- Wait with exponential backoff.+ threadDelay $ 1 `shiftL` min iteration 20+ -- Try again.+ loop errPtr $! iteration + 1+ _ -> SocketException <$> peek errPtr >>= throwIO type CSSize = CInt@@ -95,5 +133,5 @@ foreign import ccall safe "hs_getnameinfo" c_getnameinfo :: Ptr a -> CInt -> CString -> CInt -> CString -> CInt -> CInt -> IO CInt -foreign import ccall unsafe "hs_gai_strerror"- c_gai_strerror :: CInt -> IO CString+foreign import ccall unsafe "hs_getsockname"+ c_getsockname :: Fd -> Ptr a -> Ptr CInt -> Ptr CInt -> IO CInt
socket.cabal view
@@ -1,5 +1,5 @@ name: socket-version: 0.7.0.0+version: 0.8.3.0 synopsis: An extensible socket library. description: This library is a minimal cross-platform interface for@@ -14,8 +14,7 @@ cabal-version: >=1.10 homepage: https://github.com/lpeterse/haskell-socket bug-reports: https://github.com/lpeterse/haskell-socket/issues-tested-with: GHC==7.8.1, GHC==7.8.2, GHC==7.8.3, GHC==7.8.4,- GHC==7.10.1, GHC==7.10.2, GHC==7.10.3, GHC==8.0.1+tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.8.3 extra-source-files: README.md CHANGELOG.md CONTRIBUTORS.txt@@ -36,8 +35,10 @@ , System.Socket.Type.SequentialPacket , System.Socket.Protocol.UDP , System.Socket.Protocol.TCP+ , System.Socket.Protocol.Default , System.Socket.Unsafe other-modules: System.Socket.Internal.Socket+ , System.Socket.Internal.SocketOption , System.Socket.Internal.Exception , System.Socket.Internal.Message , System.Socket.Internal.AddressInfo
src/System/Socket.hsc view
@@ -74,24 +74,31 @@ , receive, receiveFrom -- ** close , close- -- * Options- , SocketOption (..)- , Error (..)- , ReuseAddress (..) -- * Name Resolution+ -- ** getAddress+ , getAddress -- ** getAddressInfo , AddressInfo (..) , HasAddressInfo (..) -- ** getNameInfo , NameInfo (..) , HasNameInfo (..)+ -- * Options+ , SocketOption (..)+ -- ** Error+ , Error (..)+ -- ** ReuseAddress+ , ReuseAddress (..)+ -- ** KeepAlive+ , KeepAlive (..) -- * Flags -- ** MessageFlags , MessageFlags (..)- , msgEndOfRecord , msgNoSignal+ , msgEndOfRecord , msgOutOfBand , msgWaitAll+ , msgPeek -- ** AddressInfoFlags , AddressInfoFlags () , aiAddressConfig@@ -126,22 +133,22 @@ import Control.Exception import Control.Monad-import Control.Applicative import Control.Concurrent import Data.Function import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS+import qualified Data.ByteString.Internal as BS -import GHC.Conc (closeFdWith)+import GHC.Conc ( closeFdWith ) -import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc import System.Socket.Unsafe import System.Socket.Internal.Socket+import System.Socket.Internal.SocketOption import System.Socket.Internal.Exception import System.Socket.Internal.Message import System.Socket.Internal.AddressInfo@@ -153,13 +160,15 @@ -- -- Whereas the underlying POSIX socket operation takes 3 parameters, this library -- encodes this information in the type variables. This rules out several--- kinds of errors and escpecially simplifies the handling of addresses (by using--- associated type families). Examples:+-- kinds of errors and especially simplifies the handling of addresses (by using+-- associated data families). Examples: ----- > -- create a IPv4-UDP-datagram socket+-- > -- create an IPv4-UDP-datagram socket -- > sock <- socket :: IO (Socket Inet Datagram UDP)--- > -- create a IPv6-TCP-streaming socket+-- > -- create an IPv6-TCP-streaming socket -- > sock6 <- socket :: IO (Socket Inet6 Stream TCP)+-- > -- create an IPv6-streaming socket with default protocol (usually TCP)+-- > sock6 <- socket :: IO (Socket Inet6 Strem Default) -- -- - This operation sets up a finalizer that automatically closes the socket -- when the garbage collection decides to collect it. This is just a@@ -174,13 +183,12 @@ -- > somethingWith sock -- your computation here -- > return somethingelse ----- -- - This operation configures the socket non-blocking to work seamlessly -- with the runtime system's event notification mechanism. -- - This operation can safely deal with asynchronous exceptions without -- leaking file descriptors.--- - This operation throws `SocketException`s. Consult your @man@ page for--- details and specific @errno@s.+-- - This operation throws `SocketException`s. Consult your @man socket@ for+-- details and specific errors. socket :: (Family f, Type t, Protocol p) => IO (Socket f t p) socket = socket' where@@ -206,37 +214,41 @@ -- - This operation returns as soon as a connection has been established (as -- if the socket were blocking). The connection attempt has either failed or -- succeeded after this operation threw an exception or returned.--- - The socket is locked throughout the whole operation. -- - The operation throws `SocketException`s. Calling `connect` on a `close`d -- socket throws `eBadFileDescriptor` even if the former file descriptor has -- been reassigned.-connect :: (Family f, Storable (SocketAddress f)) => Socket f t p -> SocketAddress f -> IO ()-connect (Socket mfd) addr =- withMVar mfd $ \fd-> do- when (fd < 0) (throwIO eBadFileDescriptor)- alloca $ \addrPtr-> alloca $ \errPtr-> do- poke addrPtr addr- let addrLen = fromIntegral (sizeOf addr)- -- The actual connection attempt.- i <- c_connect fd addrPtr addrLen errPtr- -- On non-blocking sockets we expect to get EINPROGRESS or EWOULDBLOCK.- when (i /= 0) $ do- err <- SocketException <$> peek errPtr- if err == eInProgress || err == eWouldBlock- then do- -- The manpage says that in this case the connection- -- shall be established asynchronously and one is- -- supposed to wait.- unsafeSocketWaitConnected fd- -- At least on Linux a second connect after signaled writeability- -- will not fail (the next one would).- i' <- c_connect fd addrPtr addrLen errPtr- when (i' /= 0) $ do- err' <- SocketException <$> peek errPtr- -- On Windows, the second connect fails with `eIsConnected`.- -- In our case this is not an error condition - other errors are.- when (err' /= eIsConnected) (throwIO err')- else throwIO err+connect :: (Family f) => Socket f t p -> SocketAddress f -> IO ()+connect s@(Socket mfd) addr =+ alloca $ \addrPtr-> alloca $ \errPtr-> do+ poke addrPtr addr+ let addrLen = fromIntegral (sizeOf addr)+ -- The actual connection attempt.+ i <- withMVar mfd $ \fd-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ c_connect fd addrPtr addrLen errPtr+ -- On non-blocking sockets we expect to get EINPROGRESS or EWOULDBLOCK.+ when (i /= 0) $ do+ err <- SocketException <$> peek errPtr+ if err == eInProgress || err == eWouldBlock+ then do+ -- The manpage says that in this case the connection+ -- shall be established asynchronously and one is+ -- supposed to wait.+ waitConnected s+ -- We need to issue a second connect call to get the correct error+ -- code in case the connection has been refused etc.+ -- At least on Linux a second connect after signaled writeability+ -- will not fail in case the connection has been established+ -- sucessfully (the next one would).+ i' <- withMVar mfd $ \fd-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ c_connect fd addrPtr addrLen errPtr+ when (i' /= 0) $ do+ err' <- SocketException <$> peek errPtr+ -- On Windows, the second connect fails with `eIsConnected`.+ -- In our case this is not an error condition - other errors are.+ when (err' /= eIsConnected) (throwIO err')+ else throwIO err -- | Bind a socket to an address. --@@ -248,7 +260,7 @@ -- [argued here](http://stackoverflow.com/a/14485305). -- - This operation throws `SocketException`s. Consult your @man@ page for -- details and specific @errno@s.-bind :: (Family f, Storable (SocketAddress f)) => Socket f t p -> SocketAddress f -> IO ()+bind :: (Family f) => Socket f t p -> SocketAddress f -> IO () bind (Socket mfd) addr = alloca $ \addrPtr-> alloca $ \errPtr-> do poke addrPtr addr@@ -257,15 +269,15 @@ when (i /= 0) (SocketException <$> peek errPtr >>= throwIO) -- | Starts listening and queueing connection requests on a connection-mode--- socket.+-- socket. The second parameter determines the backlog size. ----- - Calling `listen` on a `close`d socket throws `eBadFileDescriptor` even if the former--- file descriptor has been reassigned.+-- - Calling `listen` on a `close`d socket throws `eBadFileDescriptor` even+-- if the former file descriptor has been reassigned. -- - The second parameter is called /backlog/ and sets a limit on how many--- unaccepted connections the socket implementation shall queue. A value+-- unaccepted connections the transport implementation shall queue. A value -- of @0@ leaves the decision to the implementation.--- - This operation throws `SocketException`s. Consult your @man@ page for--- details and specific @errno@s.+-- - This operation throws `SocketException`s. Consult your @man listen@ for+-- details and specific errors. listen :: Socket f t p -> Int -> IO () listen (Socket ms) backlog = withMVar ms $ \s-> alloca $ \errPtr-> do@@ -274,75 +286,75 @@ -- | Accept a new connection. ----- - Calling `accept` on a `close`d socket throws `eBadFileDescriptor` even if the former--- file descriptor has been reassigned.--- - This operation configures the new socket non-blocking (TODO: use `accept4` if available).+-- - Calling `accept` on a `close`d socket throws `eBadFileDescriptor` even+-- if the former file descriptor has been reassigned.+-- - This operation configures the new socket non-blocking. It uses `accept4`+-- (when available) in order to accept and set the socket non-blocking with+-- a single system call. -- - This operation sets up a finalizer for the new socket that automatically -- closes the new socket when the garbage collection decides to collect it. -- This is just a fail-safe. You might still run out of file descriptors as -- there's no guarantee about when the finalizer is run. You're advised to -- manually `close` the socket when it's no longer needed.--- - This operation throws `SocketException`s. Consult your @man@ page for--- details and specific @errno@s.--- - This operation catches `eAgain`, `eWouldBlock` and `eInterrupted` internally--- and retries automatically.-accept :: (Family f, Storable (SocketAddress f)) => Socket f t p -> IO (Socket f t p, SocketAddress f)+-- - This operation throws `SocketException`s.+-- - This operation catches `eAgain`, `eWouldBlock` and `eInterrupted`+-- internally and retries automatically.+accept :: (Family f) => Socket f t p -> IO (Socket f t p, SocketAddress f) accept s@(Socket mfd) = accept' where- accept' :: forall f t p. (Family f, Storable (SocketAddress f)) => IO (Socket f t p, SocketAddress f)+ accept' :: forall f t p. (Family f) => IO (Socket f t p, SocketAddress f) accept' = do -- Allocate local (!) memory for the address.- alloca $ \addrPtr-> do- alloca $ \addrPtrLen-> alloca $ \errPtr-> do- poke addrPtrLen (fromIntegral $ sizeOf (undefined :: SocketAddress f))- ( fix $ \again iteration-> do- -- We mask asynchronous exceptions during this critical section.- ews <- withMVar mfd $ \fd-> do- when (fd < 0) (throwIO eBadFileDescriptor)- bracketOnError- ( c_accept fd addrPtr addrPtrLen errPtr )- ( \ft-> when (ft >= 0) $ alloca $ void . c_close ft )- ( \ft-> if ft < 0- then do- err <- SocketException <$> peek errPtr- unless (err == eWouldBlock || err == eAgain) (throwIO err)- wait <- unsafeSocketWaitRead fd iteration- return $ Left wait- else do- addr <- peek addrPtr :: IO (SocketAddress f)- -- newMVar is guaranteed to be not interruptible.- mft <- newMVar ft- -- Register a finalizer on the new socket.- _ <- mkWeakMVar mft (close (Socket mft `asTypeOf` s))- return $ Right (Socket mft, addr)- )- -- If ews is Left we got EAGAIN or EWOULDBLOCK and retry after the next event.- case ews of- Left wait -> wait >> (again $! iteration + 1)- Right sock -> return sock- ) 0 -- This is the initial iteration value.+ alloca $ \addrPtr-> alloca $ \addrPtrLen-> alloca $ \errPtr-> do+ poke addrPtrLen (fromIntegral $ sizeOf (undefined :: SocketAddress f))+ ( fix $ \again iteration-> do+ msa <- withMVar mfd $ \fd-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ bracketOnError+ ( c_accept fd addrPtr addrPtrLen errPtr )+ ( \ft-> when (ft >= 0) $ alloca $ void . c_close ft )+ ( \ft-> if ft < 0+ then do+ err <- SocketException <$> peek errPtr+ -- EWOULDBLOCK and EAGAIN are valid in case there a no+ -- queued connections at the moment and we are supposed to+ -- wait. All other errors are unexpected and we throw them.+ unless (err == eWouldBlock || err == eAgain) (throwIO err)+ return Nothing+ else do+ addr <- peek addrPtr :: IO (SocketAddress f)+ s'@(Socket mft) <- Socket <$> newMVar ft+ -- Register a finalizer on the new socket.+ _ <- mkWeakMVar mft (close s')+ return $ Just (s', addr)+ )+ -- If ews is Left we got EAGAIN or EWOULDBLOCK and retry after the next event.+ case msa of+ Just sa -> return sa+ Nothing -> waitRead s iteration >> (again $! iteration + 1)+ ) 0 -- This is the initial iteration value. --- | Send a message on a connected socket.+-- | Send data. -- -- - Calling `send` on a `close`d socket throws `eBadFileDescriptor` even if the former -- file descriptor has been reassigned.--- - The operation returns the number of bytes sent. On `Datagram` and--- `SequentialPacket` sockets certain assurances on atomicity exist and `eAgain` or--- `eWouldBlock` are returned until the whole message would fit--- into the send buffer.--- - This operation throws `SocketException`s. Consult @man 3p send@ for--- details and specific @errno@s.+-- - The operation returns the number of bytes sent. On `System.Socket.Type.Datagram`+-- and `System.Socket.Type.SequentialPacket` sockets certain assurances on+-- atomicity exist and `eAgain` or `eWouldBlock` are thrown until the+-- whole message would fit into the send buffer.+-- - This operation throws `SocketException`s. Consult @man send@ for+-- details and specific errors. -- - `eAgain`, `eWouldBlock` and `eInterrupted` and handled internally and won't -- be thrown. For performance reasons the operation first tries a write -- on the socket and then waits when it got `eAgain` or `eWouldBlock`. send :: Socket f t p -> BS.ByteString -> MessageFlags -> IO Int send s bs flags = do bytesSent <- BS.unsafeUseAsCStringLen bs $ \(bufPtr,bufSize)->- unsafeSend s (castPtr bufPtr) (fromIntegral bufSize) flags+ unsafeSend s bufPtr (fromIntegral bufSize) flags return (fromIntegral bytesSent) -- | Like `send`, but allows to specify a destination address.-sendTo ::(Family f, Storable (SocketAddress f)) => Socket f t p -> BS.ByteString -> MessageFlags -> SocketAddress f -> IO Int+sendTo ::(Family f) => Socket f t p -> BS.ByteString -> MessageFlags -> SocketAddress f -> IO Int sendTo s bs flags addr = do bytesSent <- alloca $ \addrPtr-> do poke addrPtr addr@@ -350,44 +362,39 @@ unsafeSendTo s bufPtr (fromIntegral bufSize) flags addrPtr (fromIntegral $ sizeOf addr) return (fromIntegral bytesSent) --- | Receive a message on a connected socket.+-- | Receive data. ----- - Calling `receive` on a `close`d socket throws `eBadFileDescriptor` even if the former file descriptor has been reassigned. -- - The operation takes a buffer size in bytes a first parameter which -- limits the maximum length of the returned `Data.ByteString.ByteString`.--- - This operation throws `SocketException`s. Consult @man 3p receive@ for--- details and specific @errno@s.+-- - When an empty `Data.ByteString.ByteString` is returned this usally+-- (protocol specific) means that the peer gracefully closed the connection.+-- The user is advised to check for and handle this case.+-- - Calling `receive` on a `close`d socket throws `eBadFileDescriptor` even+-- if the former file descriptor has been reassigned.+-- - This operation throws `SocketException`s. Consult @man recv@ for+-- details and specific errors. -- - `eAgain`, `eWouldBlock` and `eInterrupted` and handled internally and won't be thrown. -- For performance reasons the operation first tries a read--- on the socket and then waits when it got `eAgain` or `eWouldBlock`.+-- on the socket and then waits when it got `eAgain` or `eWouldBlock` until+-- the socket is signaled to be readable. receive :: Socket f t p -> Int -> MessageFlags -> IO BS.ByteString receive s bufSize flags =- bracketOnError- ( mallocBytes bufSize )- (\bufPtr-> free bufPtr )- (\bufPtr-> do- bytesReceived <- unsafeReceive s bufPtr (fromIntegral bufSize) flags- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)- )+ BS.createUptoN bufSize $ \bufPtr->+ fromIntegral `fmap` unsafeReceive s bufPtr (fromIntegral bufSize) flags -- | Like `receive`, but additionally yields the peer address.-receiveFrom :: (Family f, Storable (SocketAddress f)) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f)+receiveFrom :: (Family f) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f) receiveFrom = receiveFrom' where- receiveFrom' :: forall f t p. (Family f, Storable (SocketAddress f)) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f)+ receiveFrom' :: forall f t p. (Family f) => Socket f t p -> Int -> MessageFlags -> IO (BS.ByteString, SocketAddress f) receiveFrom' s bufSize flags = do alloca $ \addrPtr-> do alloca $ \addrSizePtr-> do poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f))- bracketOnError- ( mallocBytes bufSize )- (\bufPtr-> free bufPtr )- (\bufPtr-> do- bytesReceived <- unsafeReceiveFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr- addr <- peek addrPtr- bs <- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)- return (bs, addr)- )+ bs <- BS.createUptoN bufSize $ \bufPtr->+ fromIntegral `fmap` unsafeReceiveFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr+ addr <- peek addrPtr+ return (bs, addr) -- | Closes a socket. --@@ -395,7 +402,7 @@ -- If it throws an exception it is presumably a not recoverable situation and the process should exit. -- - This operation does not block. -- - This operation wakes up all threads that are currently blocking on this--- socket. All other threads are guaranteed not to block on operations on this socket in the future.+-- socket. All other threads are guaranteed to not block on operations on this socket in the future. -- Threads that perform operations other than `close` on this socket will fail with `eBadFileDescriptor` -- after the socket has been closed (`close` replaces the -- `System.Posix.Types.Fd` in the `Control.Concurrent.MVar.MVar` with @-1@@@ -426,3 +433,25 @@ -- When we arrive here, no exception has been thrown and the descriptor has been closed. -- We put an invalid file descriptor into the MVar. return (-1)++-- | Get a socket's (local) address.+--+-- > > (socket :: IO (Socket Inet Stream TCP)) >>= getAddress+-- > SocketAddressInet {inetAddress = InetAddress 0.0.0.0, inetPort = InetPort 0}+--+-- - The operation throws `SocketException`s. Calling `getAddress` on a `close`d+-- socket throws `eBadFileDescriptor` even if the former file descriptor has+-- been reassigned.+-- - Behaviour of calling `getAddress` on a socket that is neither bound nor connected+-- is undefined.+getAddress :: (Family f) => Socket f t p -> IO (SocketAddress f)+getAddress = getAddress'+ where+ getAddress' :: forall f t p. (Family f) => Socket f t p -> IO (SocketAddress f)+ getAddress' (Socket mfd) = alloca $ \addrPtr -> alloca $ \addrSizePtr -> alloca $ \errPtr -> do+ poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SocketAddress f))+ withMVar mfd $ \fd -> do+ i <- c_getsockname fd addrPtr addrSizePtr errPtr+ when (i /= 0) (SocketException <$> peek errPtr >>= throwIO)+ addr <- peek addrPtr+ return addr
src/System/Socket/Family/Inet.hsc view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Family.Inet -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -15,7 +15,6 @@ , InetAddress -- ** InetPort , InetPort- -- ** SocketAddress Inet , SocketAddress (SocketAddressInet, inetAddress, inetPort) -- * Custom addresses -- ** inetAddressFromTuple@@ -59,18 +58,17 @@ instance Family Inet where familyNumber _ = (#const AF_INET)---- | An [IPv4](https://en.wikipedia.org/wiki/IPv4) socket address.------ The socket address contains a port number that may be used by transport--- protocols like [TCP](https://en.wikipedia.org/wiki/Transmission_Control_Protocol).------ > SocketAddressInet inetLoopback 8080-data instance SocketAddress Inet- = SocketAddressInet- { inetAddress :: InetAddress- , inetPort :: InetPort- } deriving (Eq, Show)+ -- | An [IPv4](https://en.wikipedia.org/wiki/IPv4) socket address.+ --+ -- The socket address contains a port number that may be used by transport+ -- protocols like [TCP](https://en.wikipedia.org/wiki/Transmission_Control_Protocol).+ --+ -- > SocketAddressInet inetLoopback 8080+ data SocketAddress Inet+ = SocketAddressInet+ { inetAddress :: InetAddress+ , inetPort :: InetPort+ } deriving (Eq, Show) -- | To avoid errors with endianess it was decided to keep this type abstract. --@@ -91,7 +89,7 @@ deriving (Eq) newtype InetPort = InetPort Word16- deriving (Eq, Ord, Show, Num)+ deriving (Eq, Ord, Show, Num, Real, Enum, Integral) -- | Constructs a custom `InetAddress`. --
src/System/Socket/Family/Inet6.hsc view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeFamilies, FlexibleInstances, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Family.Inet6 -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -19,7 +19,6 @@ , Inet6FlowInfo -- ** Inet6ScopeId , Inet6ScopeId- -- ** SocketAddress Inet6 , SocketAddress (SocketAddressInet6, inet6Address, inet6Port, inet6FlowInfo, inet6ScopeId) -- * Custom addresses@@ -46,6 +45,7 @@ import Foreign.Storable import System.Socket.Internal.Socket+import System.Socket.Internal.SocketOption import System.Socket.Internal.Platform #include "hs_socket.h"@@ -54,25 +54,24 @@ #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).+-- | The [Internet Protocol version 6](https://en.wikipedia.org/wiki/IPv6). data Inet6 instance Family Inet6 where familyNumber _ = (#const AF_INET6)---- | An [IPv6](https://en.wikipedia.org/wiki/IPv6) socket address.------ The socket address contains a port number that may be used by transport--- protocols like [TCP](https://en.wikipedia.org/wiki/Transmission_Control_Protocol).------ > SocketAddressInet6 inet6Loopback 8080 0 0-data instance SocketAddress Inet6- = SocketAddressInet6- { inet6Address :: Inet6Address- , inet6Port :: Inet6Port- , inet6FlowInfo :: Inet6FlowInfo- , inet6ScopeId :: Inet6ScopeId- } deriving (Eq, Show)+ -- | An [IPv6](https://en.wikipedia.org/wiki/IPv6) socket address.+ --+ -- The socket address contains a port number that may be used by transport+ -- protocols like [TCP](https://en.wikipedia.org/wiki/Transmission_Control_Protocol).+ --+ -- > SocketAddressInet6 inet6Loopback 8080 0 0+ data SocketAddress Inet6+ = SocketAddressInet6+ { inet6Address :: Inet6Address+ , inet6Port :: Inet6Port+ , inet6FlowInfo :: Inet6FlowInfo+ , inet6ScopeId :: Inet6ScopeId+ } deriving (Eq, Show) -- | To avoid errors with endianess it was decided to keep this type abstract. --@@ -95,13 +94,13 @@ deriving (Eq) newtype Inet6Port = Inet6Port Word16- deriving (Eq, Ord, Show, Num)+ deriving (Eq, Ord, Show, Num, Real, Enum, Integral) newtype Inet6FlowInfo = Inet6FlowInfo Word32- deriving (Eq, Ord, Show, Num)+ deriving (Eq, Ord, Show, Num, Real, Enum, Integral) newtype Inet6ScopeId = Inet6ScopeId Word32- deriving (Eq, Ord, Show, Num)+ deriving (Eq, Ord, Show, Num, Real, Enum, Integral) -- | Deconstructs an `Inet6Address`. inet6AddressToTuple :: Inet6Address -> (Word16,Word16,Word16,Word16,Word16,Word16,Word16,Word16)
src/System/Socket/Internal/AddressInfo.hsc view
@@ -2,7 +2,7 @@ FlexibleContexts, TypeFamilies, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Internal.AddressInfo -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -45,6 +45,7 @@ import Data.Monoid import Data.Bits+import Data.Semigroup as Sem import Data.Typeable import qualified Data.ByteString as BS @@ -54,8 +55,6 @@ import Foreign.C.String import Foreign.Marshal.Alloc -import System.IO.Unsafe- import System.Socket.Family.Inet import System.Socket.Family.Inet6 import System.Socket.Internal.Socket@@ -67,10 +66,6 @@ #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) #endif ----------------------------------------------------------------------------------- AddressInfo--------------------------------------------------------------------------------- data AddressInfo f t p = AddressInfo { addressInfoFlags :: AddressInfoFlags@@ -85,24 +80,33 @@ -- AddressInfoException ------------------------------------------------------------------------------- --- | Contains the error code that can be matched against. Use `show`--- to get a human readable explanation of the error.+-- | Contains the error code that can be matched against.+--+-- Hint: Use guards or @MultiWayIf@ to match against specific exceptions:+--+-- > if | e == eaiFail -> ...+-- > | e == eaiNoName -> ...+-- > | otherwise -> ... newtype AddressInfoException = AddressInfoException CInt deriving (Eq, Typeable) instance Show AddressInfoException where- show e = "AddressInfoException \"" ++ gaiStrerror e ++ "\""+ show e+ | e == eaiAgain = "eaiAgain"+ | e == eaiBadFlags = "eaiBadFlags"+ | e == eaiFail = "eaiFail"+ | e == eaiFamily = "eaiFamily"+ | e == eaiMemory = "eaiMemory"+ | e == eaiNoName = "eaiNoName"+ | e == eaiService = "eaiService"+ | e == eaiSocketType = "eaiSocketType"+ | e == eaiSystem = "eaiSystem"+ | otherwise = let AddressInfoException n = e+ in "AddressInfoException " ++ show n instance Exception AddressInfoException --- | A wrapper around @gai_strerror@.-gaiStrerror :: AddressInfoException -> String-gaiStrerror (AddressInfoException e) =- unsafePerformIO $ do- msgPtr <- c_gai_strerror e- peekCString msgPtr- -- | > AddressInfoException "Temporary failure in name resolution" eaiAgain :: AddressInfoException eaiAgain = AddressInfoException (#const EAI_AGAIN)@@ -146,19 +150,21 @@ = AddressInfoFlags CInt deriving (Eq, Show, Bits) -instance Data.Monoid.Monoid AddressInfoFlags where- mempty- = AddressInfoFlags 0- mappend (AddressInfoFlags a) (AddressInfoFlags b)+instance Sem.Semigroup AddressInfoFlags where+ (AddressInfoFlags a) <> (AddressInfoFlags b) = AddressInfoFlags (a .|. b) +instance Data.Monoid.Monoid AddressInfoFlags where+ mempty = AddressInfoFlags 0+ mappend = (Sem.<>)+ -- | @AI_ADDRCONFIG@: aiAddressConfig :: AddressInfoFlags aiAddressConfig = AddressInfoFlags (#const AI_ADDRCONFIG) --- | @AI_ALL@: Return both IPv4 (as mapped `SocketAddressInet6`) and IPv6 addresses when--- `aiV4Mapped` is set independent of whether IPv6 addresses exist for this--- name.+-- | @AI_ALL@: Return both IPv4 (as v4-mapped IPv6 address) and IPv6 addresses+-- when `aiV4Mapped` is set independent of whether IPv6 addresses exist for+-- this name. aiAll :: AddressInfoFlags aiAll = AddressInfoFlags (#const AI_ALL) @@ -190,12 +196,14 @@ = NameInfoFlags CInt deriving (Eq, Show, Bits) -instance Monoid NameInfoFlags where- mempty- = NameInfoFlags 0- mappend (NameInfoFlags a) (NameInfoFlags b)+instance Sem.Semigroup NameInfoFlags where+ (NameInfoFlags a) <> (NameInfoFlags b) = NameInfoFlags (a .|. b) +instance Monoid NameInfoFlags where+ mempty = NameInfoFlags 0+ mappend = (Sem.<>)+ -- | @NI_NAMEREQD@: Throw an exception if the hostname cannot be determined. niNameRequired :: NameInfoFlags niNameRequired = NameInfoFlags (#const NI_NAMEREQD)@@ -216,36 +224,37 @@ niNumericService :: NameInfoFlags niNumericService = NameInfoFlags (#const NI_NUMERICSERV) +-- | This class is for address families that support name resolution. class (Family f) => HasAddressInfo f where -- | Maps names to addresses (i.e. by DNS lookup).------ The operation throws `AddressInfoException`s.------ Contrary to the underlying @getaddrinfo@ operation this wrapper is--- typesafe and thus only returns records that match the address, type--- and protocol encoded in the type. This is the price we have to pay--- for typesafe sockets and extensibility.------ If you need different types of records, you need to start several--- queries. If you want to connect to both IPv4 and IPV6 addresses use--- `aiV4Mapped` and use IPv6-sockets.------ > getAddressInfo (Just "www.haskell.org") (Just "https") mempty :: IO [AddressInfo Inet Stream TCP]--- > > [AddressInfo {addressInfoFlags = AddressInfoFlags 0, socketAddress = SocketAddressInet {inetAddress = InetAddress 162.242.239.16, inetPort = InetPort 443}, canonicalName = Nothing}]------ > > getAddressInfo (Just "www.haskell.org") (Just "80") aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]--- > [AddressInfo {--- > addressInfoFlags = AddressInfoFlags 8,--- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 2400:cb00:2048:0001:0000:0000:6ca2:cc3c, inet6Port = Inet6Port 80, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0},--- > canonicalName = Nothing }]------ > > getAddressInfo (Just "darcs.haskell.org") Nothing aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]--- > [AddressInfo {--- > addressInfoFlags = AddressInfoFlags 8,--- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 0000:0000:0000:0000:0000:ffff:17fd:e1ad, inet6Port = Inet6Port 0, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0},--- > canonicalName = Nothing }]--- > > getAddressInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddressInfo Inet6 Stream TCP]--- > *** Exception: AddressInfoException "Name or service not known"+ --+ -- The operation throws `AddressInfoException`s.+ --+ -- Contrary to the underlying @getaddrinfo@ operation this wrapper is+ -- typesafe and thus only returns records that match the address, type+ -- and protocol encoded in the type. This is the price we have to pay+ -- for typesafe sockets and extensibility.+ --+ -- If you need different types of records, you need to start several+ -- queries. If you want to connect to both IPv4 and IPV6 addresses use+ -- `aiV4Mapped` and use IPv6-sockets.+ --+ -- > getAddressInfo (Just "www.haskell.org") (Just "https") mempty :: IO [AddressInfo Inet Stream TCP]+ -- > > [AddressInfo {addressInfoFlags = AddressInfoFlags 0, socketAddress = SocketAddressInet {inetAddress = InetAddress 162.242.239.16, inetPort = InetPort 443}, canonicalName = Nothing}]+ --+ -- > > getAddressInfo (Just "www.haskell.org") (Just "80") aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]+ -- > [AddressInfo {+ -- > addressInfoFlags = AddressInfoFlags 8,+ -- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 2400:cb00:2048:0001:0000:0000:6ca2:cc3c, inet6Port = Inet6Port 80, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0},+ -- > canonicalName = Nothing }]+ --+ -- > > getAddressInfo (Just "darcs.haskell.org") Nothing aiV4Mapped :: IO [AddressInfo Inet6 Stream TCP]+ -- > [AddressInfo {+ -- > addressInfoFlags = AddressInfoFlags 8,+ -- > socketAddress = SocketAddressInet6 {inet6Address = Inet6Address 0000:0000:0000:0000:0000:ffff:17fd:e1ad, inet6Port = Inet6Port 0, inet6FlowInfo = Inet6FlowInfo 0, inet6ScopeId = Inet6ScopeId 0},+ -- > canonicalName = Nothing }]+ -- > > getAddressInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddressInfo Inet6 Stream TCP]+ -- > *** Exception: AddressInfoException "Name or service not known" getAddressInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddressInfoFlags -> IO [AddressInfo f t p] instance HasAddressInfo Inet where@@ -312,13 +321,14 @@ , serviceName :: BS.ByteString } deriving (Eq, Show) --- | Maps addresses to readable host- and service names.------ The operation throws `AddressInfoException`s.------ > > getNameInfo (SocketAddressInet inetLoopback 80) mempty--- > NameInfo {hostName = "localhost.localdomain", serviceName = "http"}+-- | This class is for address families that support reverse name resolution. class (Family f) => HasNameInfo f where+ -- | (Reverse-)map an address back to a human-readable host- and service name.+ --+ -- The operation throws `AddressInfoException`s.+ --+ -- > > getNameInfo (SocketAddressInet inetLoopback 80) mempty+ -- > NameInfo {hostName = "localhost.localdomain", serviceName = "http"} getNameInfo :: SocketAddress f -> NameInfoFlags -> IO NameInfo instance HasNameInfo Inet where
src/System/Socket/Internal/Exception.hsc view
@@ -1,14 +1,52 @@ {-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Internal.Exception -- Copyright : (c) Lars Petersen 2015 -- License : MIT -- -- Maintainer : info@lars-petersen.net -- Stability : experimental ---------------------------------------------------------------------------------module System.Socket.Internal.Exception where+module System.Socket.Internal.Exception+ ( SocketException (..)+ , eOk+ , eInterrupted+ , eBadFileDescriptor+ , ePermissionDenied+ , eInvalid+ , ePipe+ , eWouldBlock+ , eAgain+ , eNotSocket+ , eDestinationAddressRequired+ , eMessageSize+ , eProtocolType+ , eNoProtocolOption+ , eProtocolNotSupported+ , eSocketTypeNotSupported+ , eOperationNotSupported+ , eProtocolFamilyNotSupported+ , eAddressFamilyNotSupported+ , eAddressInUse+ , eAddressNotAvailable+ , eNetworkDown+ , eNetworkUnreachable+ , eNetworkReset+ , eConnectionAborted+ , eConnectionReset+ , eNoBufferSpace+ , eIsConnected+ , eNotConnected+ , eShutdown+ , eTooManyReferences+ , eTimedOut+ , eConnectionRefused+ , eHostDown+ , eHostUnreachable+ , eAlready+ , eInProgress+ ) where import Control.Exception import Data.Typeable@@ -16,6 +54,13 @@ #include "hs_socket.h" +-- | Contains the error code that can be matched against.+--+-- Hint: Use guards or @MultiWayIf@ to match against specific exceptions:+--+-- > if | e == eAddressInUse -> ...+-- > | e == eAddressNotAvailable -> ...+-- > | otherwise -> ... newtype SocketException = SocketException CInt deriving (Typeable, Eq, Ord)@@ -23,145 +68,199 @@ instance Exception SocketException instance Show SocketException where- show e@(SocketException i)- | e == eOk = "eOk"- | e == eInterrupted = "eInterrupted"- | e == eBadFileDescriptor = "eBadFileDescriptor"- | e == eInvalid = "eInvalid"- | e == ePipe = "ePipe"- | e == eWouldBlock = "eWouldBlock"- | e == eAgain = "eAgain"- | e == eNotSocket = "eNotSocket"- | e == eDestinationAddressRequired = "eDestinationAddressRequired"- | e == eMessageSize = "eMessageSize"- | e == eProtocolType = "eProtocolType"- | e == eNoProtocolOption = "eNoProtocolOption"- | e == eProtocolNotSupported = "eProtocolNotSupported"- | e == eSocketTypeNotSupported = "eSocketTypeNotSupported"- | e == eOperationNotSupported = "eOperationNotSupported"- | e == eProtocolFamilyNotSupported = "eProtocolFamilyNotSupported"- | e == eAddressFamilyNotSupported = "eAddressFamilyNotSupported"- | e == eAddressInUse = "eAddressInUse"- | e == eAddressNotAvailable = "eAddressNotAvailable"- | e == eNetworkDown = "eNetworkDown"- | e == eNetworkUnreachable = "eNetworkUnreachable"- | e == eNetworkReset = "eNetworkReset"- | e == eConnectionAborted = "eConnectionAborted"- | e == eConnectionReset = "eConnectionReset"- | e == eNoBufferSpace = "eNoBufferSpace"- | e == eIsConnected = "eIsConnected"- | e == eNotConnected = "eNotConnected"- | e == eShutdown = "eShutdown"- | e == eTooManyReferences = "eTooManyReferences"- | e == eTimedOut = "eTimedOut"- | e == eConnectionRefused = "eConnectionRefused"- | e == eHostDown = "eHostDown"- | e == eHostUnreachable = "eHostUnreachable"- | e == eAlready = "eAlready"- | e == eInProgress = "eInProgress"- | otherwise = "SocketException " ++ show i+ show e+ | e == eOk = "eOk"+ | e == eInterrupted = "eInterrupted"+ | e == eBadFileDescriptor = "eBadFileDescriptor"+ | e == ePermissionDenied = "ePermissionDenied"+ | e == eInvalid = "eInvalid"+ | e == ePipe = "ePipe"+ | e == eWouldBlock = "eWouldBlock"+ | e == eAgain = "eAgain"+ | e == eNotSocket = "eNotSocket"+ | e == eDestinationAddressRequired = "eDestinationAddressRequired"+ | e == eMessageSize = "eMessageSize"+ | e == eProtocolType = "eProtocolType"+ | e == eNoProtocolOption = "eNoProtocolOption"+ | e == eProtocolNotSupported = "eProtocolNotSupported"+ | e == eSocketTypeNotSupported = "eSocketTypeNotSupported"+ | e == eOperationNotSupported = "eOperationNotSupported"+ | e == eProtocolFamilyNotSupported = "eProtocolFamilyNotSupported"+ | e == eAddressFamilyNotSupported = "eAddressFamilyNotSupported"+ | e == eAddressInUse = "eAddressInUse"+ | e == eAddressNotAvailable = "eAddressNotAvailable"+ | e == eNetworkDown = "eNetworkDown"+ | e == eNetworkUnreachable = "eNetworkUnreachable"+ | e == eNetworkReset = "eNetworkReset"+ | e == eConnectionAborted = "eConnectionAborted"+ | e == eConnectionReset = "eConnectionReset"+ | e == eNoBufferSpace = "eNoBufferSpace"+ | e == eIsConnected = "eIsConnected"+ | e == eNotConnected = "eNotConnected"+ | e == eShutdown = "eShutdown"+ | e == eTooManyReferences = "eTooManyReferences"+ | e == eTimedOut = "eTimedOut"+ | e == eConnectionRefused = "eConnectionRefused"+ | e == eHostDown = "eHostDown"+ | e == eHostUnreachable = "eHostUnreachable"+ | e == eAlready = "eAlready"+ | e == eInProgress = "eInProgress"+ | otherwise = let SocketException n = e+ in "SocketException " ++ show n +-- | No error. eOk :: SocketException eOk = SocketException (#const SEOK) +-- | Interrupted system call.+--+-- NOTE: This exception shall not be thrown by any public operation in this+-- library, but is handled internally. eInterrupted :: SocketException eInterrupted = SocketException (#const SEINTR) +-- | Bad file descriptor. eBadFileDescriptor :: SocketException eBadFileDescriptor = SocketException (#const SEBADF) +-- | Permission denied.+ePermissionDenied :: SocketException+ePermissionDenied = SocketException (#const SEACCES)++-- | Invalid argument. eInvalid :: SocketException eInvalid = SocketException (#const SEINVAL) +-- | Broken pipe. ePipe :: SocketException ePipe = SocketException (#const SEPIPE) +-- | Resource temporarily unavailable.+--+-- NOTE: This exception shall not be thrown by any public operation in this+-- library, but is handled internally. eWouldBlock :: SocketException eWouldBlock = SocketException (#const SEWOULDBLOCK) +-- | Resource temporarily unavailable. eAgain :: SocketException eAgain = SocketException (#const SEAGAIN) +-- | Socket operation on non-socket.+--+-- NOTE: This should be ruled out by the type system. eNotSocket :: SocketException eNotSocket = SocketException (#const SENOTSOCK) +-- | Destination address required. eDestinationAddressRequired :: SocketException eDestinationAddressRequired = SocketException (#const SEDESTADDRREQ) +-- | Message too long. eMessageSize :: SocketException eMessageSize = SocketException (#const SEMSGSIZE) +-- | Protocol wrong type for socket.++-- NOTE: This should be ruled out by the type system. eProtocolType :: SocketException eProtocolType = SocketException (#const SEPROTOTYPE) +-- | Protocol not available. eNoProtocolOption :: SocketException eNoProtocolOption = SocketException (#const SENOPROTOOPT) +-- | Protocol not supported. eProtocolNotSupported :: SocketException eProtocolNotSupported = SocketException (#const SEPROTONOSUPPORT) +-- | Socket type not supported. eSocketTypeNotSupported :: SocketException eSocketTypeNotSupported = SocketException (#const SESOCKTNOSUPPORT) +-- | Operation not supported. eOperationNotSupported :: SocketException eOperationNotSupported = SocketException (#const SEOPNOTSUPP) +-- | Protocol family not supported. eProtocolFamilyNotSupported :: SocketException eProtocolFamilyNotSupported = SocketException (#const SEPFNOSUPPORT) +-- | Address family not supported by protocol. eAddressFamilyNotSupported :: SocketException eAddressFamilyNotSupported = SocketException (#const SEAFNOSUPPORT) +-- | Address already in use. eAddressInUse :: SocketException eAddressInUse = SocketException (#const SEADDRINUSE) +-- | Cannot assign requested address. eAddressNotAvailable :: SocketException eAddressNotAvailable = SocketException (#const SEADDRNOTAVAIL) +-- | Network is down. eNetworkDown :: SocketException eNetworkDown = SocketException (#const SENETDOWN) +-- | Network is unreachable. eNetworkUnreachable :: SocketException eNetworkUnreachable = SocketException (#const SENETUNREACH) +-- | Network dropped connection on reset. eNetworkReset :: SocketException eNetworkReset = SocketException (#const SENETRESET) +-- | Software caused connection abort. eConnectionAborted :: SocketException eConnectionAborted = SocketException (#const SECONNABORTED) +-- | Connection reset by peer. eConnectionReset :: SocketException eConnectionReset = SocketException (#const SECONNRESET) +-- | No buffer space available. eNoBufferSpace :: SocketException eNoBufferSpace = SocketException (#const SENOBUFS) +-- | Transport endpoint is already connected. eIsConnected :: SocketException eIsConnected = SocketException (#const SEISCONN) +-- | Transport endpoint is not connected. eNotConnected :: SocketException eNotConnected = SocketException (#const SENOTCONN) +-- | Cannot send after transport endpoint shutdown. eShutdown :: SocketException eShutdown = SocketException (#const SESHUTDOWN) +-- | Too many references: cannot splice. eTooManyReferences :: SocketException eTooManyReferences = SocketException (#const SETOOMANYREFS) +-- | Connection timed out. eTimedOut :: SocketException eTimedOut = SocketException (#const SETIMEDOUT) +-- | Connection refused. eConnectionRefused :: SocketException eConnectionRefused = SocketException (#const SECONNREFUSED) +-- | Host is down. eHostDown :: SocketException eHostDown = SocketException (#const SEHOSTDOWN) +-- | No route to host. eHostUnreachable :: SocketException eHostUnreachable = SocketException (#const SEHOSTUNREACH) +-- | Operation already in progress.+--+-- NOTE: This exception shall not be thrown by any public operation in this+-- library, but is handled internally. eAlready :: SocketException eAlready = SocketException (#const SEALREADY) +-- | Operation now in progress eInProgress :: SocketException eInProgress = SocketException (#const SEINPROGRESS)
src/System/Socket/Internal/Message.hsc view
@@ -1,7 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Internal.Message -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -10,17 +10,18 @@ -------------------------------------------------------------------------------- module System.Socket.Internal.Message ( MessageFlags (..)- , Message , msgEndOfRecord , msgNoSignal , msgOutOfBand , msgWaitAll+ , msgPeek ) where import Data.Bits import Data.Monoid import Data.Maybe import Data.List (intersperse)+import Data.Semigroup as Sem import Foreign.C.Types import Foreign.Storable@@ -38,11 +39,12 @@ = MessageFlags CInt deriving (Eq, Bits, Storable) -data Message a t p+instance Sem.Semigroup MessageFlags where+ (<>) = (.|.) instance Monoid MessageFlags where mempty = MessageFlags 0- mappend = (.|.)+ mappend = (Sem.<>) instance Show MessageFlags where show msg = "mconcat [" ++ y ++ "]"@@ -51,15 +53,12 @@ , if msg .&. msgNoSignal /= mempty then Just "msgNoSignal" else Nothing , if msg .&. msgOutOfBand /= mempty then Just "msgOutOfBand" else Nothing , if msg .&. msgWaitAll /= mempty then Just "msgWaitAll" else Nothing- , let (MessageFlags i) = msg `xor` (Data.Monoid.mconcat [msgEndOfRecord,msgNoSignal,msgOutOfBand,msgWaitAll] .&. msg)+ , if msg .&. msgWaitAll /= mempty then Just "msgPeek" else Nothing+ , let (MessageFlags i) = msg `xor` (Data.Monoid.mconcat [msgEndOfRecord,msgNoSignal,msgOutOfBand,msgWaitAll,msgPeek] .&. msg) in if i /= 0 then Just ("MessageFlags " ++ show i) else Nothing ] y = concat $ intersperse "," $ catMaybes x --- | @MSG_EOR@-msgEndOfRecord :: MessageFlags-msgEndOfRecord = MessageFlags (#const MSG_EOR)- -- | @MSG_NOSIGNAL@ -- -- Suppresses the generation of @PIPE@ signals when writing to a socket@@ -83,13 +82,41 @@ -- ignores them if you don't hook them explicitly. The -- non-portable socket option `SO_NOSIGPIPE` may be used disable signals -- on a per-socket basis.+--+-- __/It is safe and advised to always use this flag unless one wants to/__+-- __/explictly hook and handle the @PIPE@ signal which is not very useful in todays/__+-- __/multi-threaded environments anyway. Although GHC's RTS ignores the/__+-- __/signal by default it causes an unnecessary interruption./__ msgNoSignal :: MessageFlags msgNoSignal = MessageFlags (#const MSG_NOSIGNAL) +-- | @MSG_EOR@+--+-- Used by `System.Socket.Type.SequentialPacket.SequentialPacket` to mark record boundaries.+-- Consult the POSIX standard for details.+msgEndOfRecord :: MessageFlags+msgEndOfRecord = MessageFlags (#const MSG_EOR)+{-# WARNING msgEndOfRecord "Untested: Use at your own risk!" #-}+ -- | @MSG_OOB@+--+-- Used to send and receive out-of-band data. Consult the relevant standards+-- for details. msgOutOfBand :: MessageFlags msgOutOfBand = MessageFlags (#const MSG_OOB)+{-# WARNING msgOutOfBand "Untested: Use at your own risk!" #-} -- | @MSG_WAITALL@+--+-- A `System.Socket.receive` call shall not return unless the requested number of+-- bytes becomes available. msgWaitAll :: MessageFlags msgWaitAll = MessageFlags (#const MSG_WAITALL)+{-# WARNING msgWaitAll "Untested: Use at your own risk!" #-}++-- | @MSG_PEEK@+--+-- A `System.Socket.receive` shall not actually remove the received+-- data from the input buffer.+msgPeek :: MessageFlags+msgPeek = MessageFlags (#const MSG_PEEK)
+ src/System/Socket/Internal/Socket.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Internal.Socket+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+--------------------------------------------------------------------------------+module System.Socket.Internal.Socket (+ Socket (..)+ , Family (..)+ , Type (..)+ , Protocol (..)+ ) where++import Control.Concurrent.MVar+import Foreign.C.Types+import Foreign.Storable+import System.Posix.Types++-- | A generic socket type. Use `System.Socket.socket` to create a new socket.+--+-- The socket is just an `Control.Concurrent.MVar.MVar`-wrapped file descriptor.+-- The `System.Socket.Unsafe.Socket` constructor is exported trough the unsafe+-- module in order to make this library easily extensible, but it is usually+-- not necessary nor advised to work directly on the file descriptor.+-- If you do, the following rules must be obeyed:+--+-- - Make sure not to deadlock. Use `Control.Concurrent.MVar.withMVar` or similar.+-- - The lock __must not__ be held during a blocking call. This would make it impossible+-- to send and receive simultaneously or to close the socket.+-- - The lock __must__ be held when calling operations that use the file descriptor.+-- Otherwise the socket might get closed or even reused by another+-- thread/capability which might result in reading from or writing on a+-- totally different socket. This is a security nightmare!+-- - The socket is non-blocking and all the code relies on that assumption.+-- You need to use GHC's eventing mechanism primitives to block until+-- something happens. The former rules forbid to use `GHC.Conc.threadWaitRead` as it+-- does not separate between registering the file descriptor (for which+-- the lock __must__ be held) and the actual waiting (for which you must+-- __not__ hold the lock).+-- Also see [this](https://mail.haskell.org/pipermail/haskell-cafe/2014-September/115823.html)+-- thread and read the library code to see how the problem is currently circumvented.+newtype Socket f t p+ = Socket (MVar Fd)++-- | The address `Family` determines the network protocol to use.+--+-- The most common address families are `System.Socket.Family.Inet.Inet` (IPv4)+-- and `System.Socket.Family.Inet6.Inet6` (IPv6).+class Storable (SocketAddress f) => Family f where+ -- | The number designating this `Family` on the specific platform. This+ -- method is only exported for implementing extension libraries.+ --+ -- This function shall yield the values of constants like `AF_INET`, `AF_INET6` etc.+ familyNumber :: f -> CInt+ -- | The `SocketAddress` type is a [data family](https://wiki.haskell.org/GHC/Type_families#Detailed_definition_of_data_families).+ -- This allows to provide different data constructors depending on the socket+ -- family without knowing all of them in advance or the need to extend this+ -- core library.+ --+ -- > SocketAddressInet inetLoopback 8080 :: SocketAddress Inet+ -- > SocketAddressInet6 inet6Loopback 8080 0 0 :: SocketAddress Inet6+ data SocketAddress f++-- | The `Type` determines properties of the transport layer and the semantics+-- of basic socket operations.+--+-- The instances supplied by this library are `System.Socket.Type.Raw`+-- (no transport layer), `System.Socket.Type.Stream`+-- (for unframed binary streams, e.g. `System.Socket.Protocol.TCP`),+-- `System.Socket.Type.Datagram` (for datagrams+-- of limited length, e.g. `System.Socket.Protocol.UDP`) and+-- `System.Socket.Type.SequentialPacket` (for framed messages of arbitrary+-- length, e.g. `System.Socket.Protocol.SCTP`).+class Type t where+ -- | This number designates this `Type` on the specific platform. This+ -- method is only exported for implementing extension libraries.+ --+ -- The function shall yield the values of constants like `SOCK_STREAM`,+ -- `SOCK_DGRAM` etc.+ typeNumber :: t -> CInt++-- | The `Protocol` determines the transport protocol to use.+--+-- Use `System.Socket.Protocol.Default` to let the operating system choose+-- a transport protocol compatible with the socket's `Type`.+class Protocol p where+ -- | This number designates this `Protocol` on the specific platform. This+ -- method is only exported for implementing extension libraries.+ --+ -- The function shall yield the values of constants like `IPPROTO_TCP`,+ -- `IPPROTO_UDP` etc.+ protocolNumber :: p -> CInt
− src/System/Socket/Internal/Socket.hsc
@@ -1,128 +0,0 @@-{-# LANGUAGE TypeFamilies #-}------------------------------------------------------------------------------------ |--- Module : System.Socket--- Copyright : (c) Lars Petersen 2015--- License : MIT------ Maintainer : info@lars-petersen.net--- Stability : experimental----------------------------------------------------------------------------------module System.Socket.Internal.Socket (- Socket (..)- , SocketAddress- , Family (..)- , Type (..)- , Protocol (..)- , SocketOption (..)- , unsafeGetSocketOption- , unsafeSetSocketOption- , Error (..)- , ReuseAddress (..)- ) where--import Control.Concurrent.MVar-import Control.Exception-import Control.Monad-import Control.Applicative ((<$>))--import Foreign.Ptr-import Foreign.Storable-import Foreign.C.Types-import Foreign.Marshal.Alloc-import System.Posix.Types--import System.Socket.Internal.Platform-import System.Socket.Internal.Exception--#include "hs_socket.h"---- | A generic socket type. Use `System.Socket.socket` to create a new socket.------ The socket is just an `Control.Concurrent.MVar.MVar`-wrapped file descriptor.--- The `System.Socket.Unsafe.Socket` constructor is exported trough the unsafe--- module in order to make this library easily extensible, but it is usually--- not necessary nor advised to work directly on the file descriptor.--- If you do, the following rules must be obeyed:------ - Make sure not to deadlock. Use `Control.Concurrent.MVar.withMVar` or similar.--- - The lock __must not__ be held during a blocking call. This would make it impossible--- to send and receive simultaneously or to close the socket.--- - The lock __must__ be held when calling operations that use the file descriptor.--- Otherwise the socket might get closed or even reused by another--- thread/capability which might result in reading from or writing--- totally different connection. This is a security nightmare!--- - The socket is non-blocking and all the code relies on that assumption.--- You need to use GHC's eventing mechanism primitives to block until--- something happens. The former rules forbid to use `GHC.Conc.threadWaitRead` as it--- does not separate between registering the file descriptor (for which--- the lock __must__ be held) and the actual waiting (for which you must--- __not__ hold the lock).--- Also see [this](https://mail.haskell.org/pipermail/haskell-cafe/2014-September/115823.html)--- thread and read the library code to see how the problem is currently circumvented.-newtype Socket f t p- = Socket (MVar Fd)---- | The `SocketAddress` type is a [data family](https://wiki.haskell.org/GHC/Type_families#Detailed_definition_of_data_families).--- This allows to provide different data constructors depending on the socket--- family wihtout knowing all of them in advance or the need to patch this--- core library.------ > SocketAddressInet inetLoopback 8080 :: SocketAddress Inet--- > SocketAddressInet6 inet6Loopback 8080 0 0 :: SocketAddress Inet6-data family SocketAddress f--class Family f where- familyNumber :: f -> CInt--class Type t where- typeNumber :: t -> CInt--class Protocol p where- protocolNumber :: p -> CInt--class SocketOption o where- getSocketOption :: Socket f t p -> IO o- setSocketOption :: Socket f t p -> o -> IO ()---- | @SO_ERROR@-data Error- = Error SocketException- deriving (Eq, Ord, Show)--instance SocketOption Error where- getSocketOption s =- Error . SocketException Control.Applicative.<$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_ERROR)- setSocketOption _ _ = throwIO eInvalid---- | @SO_REUSEADDR@-data ReuseAddress- = ReuseAddress Bool- deriving (Eq, Ord, Show)--instance SocketOption ReuseAddress where- getSocketOption s =- ReuseAddress . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR)- setSocketOption s (ReuseAddress o) =- unsafeSetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR) (if o then 1 else 0 :: CInt)------------------------------------------------------------------------------------ Unsafe helpers----------------------------------------------------------------------------------unsafeSetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> a -> IO ()-unsafeSetSocketOption (Socket mfd) level name value =- withMVar mfd $ \fd-> alloca $ \vPtr-> alloca $ \errPtr-> do- poke vPtr value- i <- c_setsockopt fd level name vPtr (fromIntegral $ sizeOf value) errPtr- when (i < 0) (SocketException <$> peek errPtr >>= throwIO)--unsafeGetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> IO a-unsafeGetSocketOption (Socket mfd) level name =- withMVar mfd $ \fd-> alloca $ \vPtr-> alloca $ \lPtr-> alloca $ \errPtr-> do- u <- return undefined- poke lPtr (fromIntegral $ sizeOf u)- i <- c_getsockopt fd level name vPtr (lPtr :: Ptr CInt) errPtr- when (i < 0) (SocketException <$> peek errPtr >>= throwIO)- x <- peek vPtr- return (x `asTypeOf` u)
+ src/System/Socket/Internal/SocketOption.hsc view
@@ -0,0 +1,115 @@+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Internal.SocketOption+-- Copyright : (c) Lars Petersen 2016+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+--------------------------------------------------------------------------------+module System.Socket.Internal.SocketOption (+ SocketOption (..)+ , unsafeGetSocketOption+ , unsafeSetSocketOption+ , Error (..)+ , ReuseAddress (..)+ , KeepAlive(..)+ ) where++import Control.Concurrent.MVar+import Control.Exception+import Control.Monad+import Control.Applicative ((<$>))++import Foreign.Ptr+import Foreign.Storable+import Foreign.C.Types+import Foreign.Marshal.Alloc++import System.Socket.Internal.Socket+import System.Socket.Internal.Platform+import System.Socket.Internal.Exception++#include "hs_socket.h"++-- | `SocketOption`s allow to read and write certain properties of a socket.+--+-- - Each option shall have a corresponding data type that models the data+-- associated with the socket option.+-- - Use `System.Socket.Unsafe.unsafeGetSocketOption` and+-- `System.Socket.Unsafe.unsafeSetSocketOption` in order to implement custom socket+-- options.+class SocketOption o where+ -- | Get a specific `SocketOption`.+ --+ -- - This operation throws `SocketException`s. Consult @man getsockopt@ for+ -- details and specific errors.+ getSocketOption :: Socket f t p -> IO o+ -- | Set a specific `SocketOption`.+ --+ -- - This operation throws `SocketException`s. Consult @man setsockopt@ for+ -- details and specific errors.+ setSocketOption :: Socket f t p -> o -> IO ()++-- | Reports the last error that occured on the socket.+--+-- - Also known as @SO_ERROR@.+-- - The operation `setSocketOption` always throws `eInvalid` for this option.+-- - Use with care in the presence of concurrency!+data Error+ = Error SocketException+ deriving (Eq, Ord, Show)++instance SocketOption Error where+ getSocketOption s =+ Error . SocketException Control.Applicative.<$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_ERROR)+ setSocketOption _ _ = throwIO eInvalid++-- | Allows or disallows the reuse of a local address in a `System.Socket.bind` call.+--+-- - Also known as @SO_REUSEADDR@.+-- - This is particularly useful when experiencing `eAddressInUse` exceptions.+data ReuseAddress+ = ReuseAddress Bool+ deriving (Eq, Ord, Show)++instance SocketOption ReuseAddress where+ getSocketOption s =+ ReuseAddress . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR)+ setSocketOption s (ReuseAddress o) =+ unsafeSetSocketOption s (#const SOL_SOCKET) (#const SO_REUSEADDR) (if o then 1 else 0 :: CInt)++-- | When enabled the protocol checks in a protocol-specific manner+-- if the other end is still alive.+--+-- - Also known as @SO_KEEPALIVE@.+data KeepAlive+ = KeepAlive Bool+ deriving (Eq, Ord, Show)++instance SocketOption KeepAlive where+ getSocketOption s =+ KeepAlive . ((/=0) :: CInt -> Bool) <$> unsafeGetSocketOption s (#const SOL_SOCKET) (#const SO_KEEPALIVE)+ setSocketOption s (KeepAlive o) =+ unsafeSetSocketOption s (#const SOL_SOCKET) (#const SO_KEEPALIVE) (if o then 1 else 0 :: CInt)++-------------------------------------------------------------------------------+-- Unsafe helpers+-------------------------------------------------------------------------------++unsafeSetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> a -> IO ()+unsafeSetSocketOption (Socket mfd) level name value =+ withMVar mfd $ \fd-> alloca $ \vPtr-> alloca $ \errPtr-> do+ poke vPtr value+ i <- c_setsockopt fd level name vPtr (fromIntegral $ sizeOf value) errPtr+ when (i < 0) (SocketException <$> peek errPtr >>= throwIO)++unsafeGetSocketOption :: Storable a => Socket f t p -> CInt -> CInt -> IO a+unsafeGetSocketOption (Socket mfd) level name =+ withMVar mfd $ \fd-> alloca $ \vPtr-> alloca $ \lPtr-> alloca $ \errPtr-> do+ u <- return undefined+ poke lPtr (fromIntegral $ sizeOf u)+ i <- c_getsockopt fd level name vPtr (lPtr :: Ptr CInt) errPtr+ when (i < 0) (SocketException <$> peek errPtr >>= throwIO)+ x <- peek vPtr+ return (x `asTypeOf` u)
+ src/System/Socket/Protocol/Default.hsc view
@@ -0,0 +1,19 @@+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Protocol.Default+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+--------------------------------------------------------------------------------+module System.Socket.Protocol.Default where++import System.Socket.Internal.Socket++#include "hs_socket.h"++data Default++instance Protocol Default where+ protocolNumber _ = 0
src/System/Socket/Protocol/TCP.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Protocol.TCP -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -9,11 +9,27 @@ -------------------------------------------------------------------------------- module System.Socket.Protocol.TCP where +import Foreign.C.Types+ import System.Socket.Internal.Socket+import System.Socket.Internal.SocketOption #include "hs_socket.h" data TCP -instance Protocol TCP where+instance Protocol TCP where protocolNumber _ = (#const IPPROTO_TCP)++-- | If set to True, disable the Nagle's algorithm.+--+-- - Also know as @TCP_NODELAY@.+data NoDelay+ = NoDelay Bool+ deriving (Eq, Ord, Show)++instance SocketOption NoDelay where+ getSocketOption s =+ (NoDelay . (/=0) :: CInt -> NoDelay) `fmap` unsafeGetSocketOption s (#const IPPROTO_TCP) (#const TCP_NODELAY)+ setSocketOption s (NoDelay o) =+ unsafeSetSocketOption s (#const IPPROTO_TCP) (#const TCP_NODELAY) (if o then 1 else 0 :: CInt)
src/System/Socket/Protocol/UDP.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Protocol.UDP -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -15,5 +15,5 @@ data UDP -instance Protocol UDP where+instance Protocol UDP where protocolNumber _ = (#const IPPROTO_UDP)
src/System/Socket/Type/Datagram.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Type.Datagram -- Copyright : (c) Lars Petersen 2015 -- License : MIT --
src/System/Socket/Type/Raw.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Type.Raw -- Copyright : (c) Lars Petersen 2015 -- License : MIT --
src/System/Socket/Type/SequentialPacket.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Type.SequentialPacket -- Copyright : (c) Lars Petersen 2015 -- License : MIT --
src/System/Socket/Type/Stream.hsc view
@@ -1,6 +1,6 @@ -------------------------------------------------------------------------------- -- |--- Module : System.Socket+-- Module : System.Socket.Type.Stream -- Copyright : (c) Lars Petersen 2015 -- License : MIT --@@ -132,8 +132,8 @@ -- - The `Data.Int.Int64` parameter is a soft limit on how many bytes to receive. -- Collection is stopped if the limit has been exceeded. The result might -- be up to one internal buffer size longer than the given limit.--- If the returned `Data.ByteString.Lazy.ByteString`s length is lower or--- eqal than the limit, the data has not been truncated and the+-- If the returned `Data.ByteString.Lazy.ByteString`s length is lower than or+-- equal to the limit, the data has not been truncated and the -- transmission is complete. receiveAll :: Socket f Stream p -> Int64 -> MessageFlags -> IO LBS.ByteString receiveAll sock maxLen flags = collect 0 Data.Monoid.mempty@@ -150,3 +150,5 @@ $! (accum `Data.Monoid.mappend` BB.byteString bs) build accum = do return (BB.toLazyByteString accum)++{-# DEPRECATED receiveAll "Semantics will change in the next major release. Don't use it anymore!" #-}
+ src/System/Socket/Unsafe.hs view
@@ -0,0 +1,102 @@+--------------------------------------------------------------------------------+-- |+-- Module : System.Socket.Unsafe+-- Copyright : (c) Lars Petersen 2015+-- License : MIT+--+-- Maintainer : info@lars-petersen.net+-- Stability : experimental+--------------------------------------------------------------------------------+module System.Socket.Unsafe (+ Socket (..)+ -- * Unsafe operations+ -- ** unsafeSend+ , unsafeSend+ -- ** unsafeSendTo+ , unsafeSendTo+ -- ** unsafeReceive+ , unsafeReceive+ -- ** unsafeReceiveFrom+ , unsafeReceiveFrom+ -- ** unsafeGetSocketOption+ , unsafeGetSocketOption+ -- ** unsafeSetSocketOption+ , unsafeSetSocketOption+ -- * Waiting for events+ -- ** waitRead+ , waitRead+ -- ** waitWrite+ , waitWrite+ -- ** waitConnected+ , waitConnected+ -- ** tryWaitRetryLoop+ , tryWaitRetryLoop+ ) where++import Control.Concurrent.MVar+import Control.Exception ( throwIO )+import Control.Monad+import Foreign.C.Types+import Foreign.Ptr+import Foreign.Marshal+import Foreign.Storable+import System.Posix.Types ( Fd(..) )+import System.Socket.Internal.Socket+import System.Socket.Internal.SocketOption+import System.Socket.Internal.Platform+import System.Socket.Internal.Exception+import System.Socket.Internal.Message++-- | Like `System.Socket.send`, but using `Ptr` and length instead of a `ByteString`.+--+-- This function is /unsafe/. @bufPtr@ must refer to a buffer which size is at least @bufSize@ bytes.+unsafeSend :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt+unsafeSend s bufPtr bufSize flags =+ tryWaitRetryLoop s waitWrite (\fd-> c_send fd bufPtr bufSize flags )++-- | Like `System.Socket.sendTo`, but using `Ptr` and length instead of a `ByteString`.+--+-- This function is /unsafe/. @bufPtr@ must refer to a buffer which size is at least @bufSize@ bytes.+unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt+unsafeSendTo s bufPtr bufSize flags addrPtr addrSize =+ tryWaitRetryLoop s waitWrite (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) flags addrPtr addrSize)++-- | Like `System.Socket.receive`, but using `Ptr` and length instead of a `ByteString`.+--+-- This function is /unsafe/. @bufPtr@ must refer to a buffer which size is at least @bufSize@ bytes.+unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt+unsafeReceive s bufPtr bufSize flags =+ tryWaitRetryLoop s waitRead (\fd-> c_recv fd bufPtr bufSize flags)++-- | Like `System.Socket.receiveFrom`, but using `Ptr` and length instead of a `ByteString`.+--+-- This function is /unsafe/. @bufPtr@ must refer to a buffer which size is at least @bufSize@ bytes.+unsafeReceiveFrom :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> Ptr CInt -> IO CInt+unsafeReceiveFrom s bufPtr bufSize flags addrPtr addrSizePtr =+ tryWaitRetryLoop s waitRead (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr)++tryWaitRetryLoop :: Socket f t p -> (Socket f t p -> Int -> IO ()) -> (Fd -> Ptr CInt -> IO CInt) -> IO CInt+tryWaitRetryLoop s@(Socket mfd) wait action = loop 0+ where+ loop iteration = do+ -- acquire lock on socket+ mi <- withMVar mfd $ \fd-> alloca $ \errPtr-> do+ when (fd < 0) (throwIO eBadFileDescriptor)+ i <- action fd errPtr+ if i < 0 then do+ err <- SocketException <$> peek errPtr+ unless (err == eWouldBlock || err == eAgain || err == eInterrupted)+ (throwIO err)+ return Nothing+ else+ -- The following is quite interesting for debugging:+ -- when (iteration /= 0) (print iteration)+ return (Just i)+ -- lock on socket is release here+ case mi of+ Just i ->+ return i+ Nothing -> do+ wait s iteration -- this call is (eventually) blocking+ loop $! iteration + 1 -- tail recursion+
− src/System/Socket/Unsafe.hsc
@@ -1,92 +0,0 @@------------------------------------------------------------------------------------ |--- Module : System.Socket--- Copyright : (c) Lars Petersen 2015--- License : MIT------ Maintainer : info@lars-petersen.net--- Stability : experimental----------------------------------------------------------------------------------module System.Socket.Unsafe (- -- * Socket Constructor- Socket (..)- -- * Socket Operations- -- ** unsafeSend- , unsafeSend- -- ** unsafeSendTo- , unsafeSendTo- -- ** unsafeReceive- , unsafeReceive- -- ** unsafeReceiveFrom- , unsafeReceiveFrom- -- * Socket Options- -- ** unsafeGetSocketOption- , unsafeGetSocketOption- -- ** unsafeSetSocketOption- , unsafeSetSocketOption- -- * Waiting For Events- -- ** unsafeSocketWaitRead- , unsafeSocketWaitRead- -- ** unsafeSocketWaitWrite- , unsafeSocketWaitWrite- -- * Other Helpers- -- ** tryWaitRetryLoop- , tryWaitRetryLoop- ) where--import Control.Applicative ((<$>))-import Control.Monad-import Control.Exception-import Control.Concurrent.MVar--import Foreign.C.Types-import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Alloc--import System.Socket.Internal.Socket-import System.Socket.Internal.Platform-import System.Socket.Internal.Exception-import System.Socket.Internal.Message--import System.Posix.Types (Fd)--#include "hs_socket.h"--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 )--unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> CInt -> IO CInt-unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do- tryWaitRetryLoop s unsafeSocketWaitWrite (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) flags addrPtr addrSize)--unsafeReceive :: Socket a t p -> Ptr b -> CSize -> MessageFlags -> IO CInt-unsafeReceive s bufPtr bufSize flags =- tryWaitRetryLoop s unsafeSocketWaitRead (\fd-> c_recv fd bufPtr bufSize flags)--unsafeReceiveFrom :: Socket f t p -> Ptr b -> CSize -> MessageFlags -> Ptr (SocketAddress f) -> Ptr CInt -> IO CInt-unsafeReceiveFrom s bufPtr bufSize flags addrPtr addrSizePtr = do- tryWaitRetryLoop s unsafeSocketWaitRead (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr)--tryWaitRetryLoop :: Socket f t p -> (Fd -> Int-> IO (IO ())) -> (Fd -> Ptr CInt -> IO CInt) -> IO CInt-tryWaitRetryLoop (Socket mfd) getWaitAction action = loop 0- where- loop iteration = do- ewr <- withMVar mfd $ \fd-> alloca $ \errPtr-> do- when (fd < 0) (throwIO eBadFileDescriptor)- i <- action fd errPtr- if (i < 0) then do- err <- SocketException <$> peek errPtr- unless (err == eWouldBlock || err == eAgain) (throwIO err)- Left <$> getWaitAction fd iteration- else- -- The following is quite interesting for debugging:- -- when (iteration /= 0) (print iteration)- return (Right i)- case ewr of- Left wait -> do- wait- loop $! iteration + 1- Right result -> do- return result
test/test.hs view
@@ -1,27 +1,29 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -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 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 as BS+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 (mappend, mempty)+import Prelude hiding (head) import System.Socket import System.Socket.Family.Inet import System.Socket.Family.Inet6+import System.Socket.Protocol.Default 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+import Test.Tasty.QuickCheck as QC main :: IO () main = defaultMain $ testGroup "socket"@@ -32,6 +34,7 @@ , group03 , group07 , group80+ , group98 , group99 ] , testGroup "System.Socket.Inet" [@@ -48,7 +51,7 @@ group00 :: TestTree group00 = testGroup "accept"- [ testGroup "Inet/Strem/TCP"+ [ testGroup "Inet/Stream/TCP" [ testCase "cancel operation" $ -- | This is to test interruptability of (blocking) calls like -- accept. The implementation may either run the call "safe"@@ -203,6 +206,32 @@ msg <- wait serverRecv when (msg /= helloWorld) (assertFailure "Received message was bogus.") )+ , testCase "recv empty bytestring when peer disconnected gracefully" $ bracket+ ( socket :: IO (Socket Inet Stream TCP) ) close+ (\server-> do+ let addr = SocketAddressInet inetLoopback port+ let msg = "msg"+ setSocketOption server (ReuseAddress True)+ bind server addr+ listen server 5+ (peer,msg') <- bracket ( socket :: IO (Socket Inet Stream TCP) ) close+ (\client-> do+ connect client addr+ (peer, _) <- accept server+ _ <- send client msg mempty+ msg' <- receive peer 4096 mempty+ return (peer,msg')+ )+ -- The client is disconnected after here.+ when (msg' /= msg) $+ assertFailure "Received message does not match."+ msg'' <- receive peer 4096 mempty+ unless (BS.null msg'') $+ assertFailure "Expected subsequent receives to return empty bytestring."+ msg''' <- receive peer 4096 mempty+ unless (BS.null msg''') $+ assertFailure "Expected subsequent receives to return empty bytestring."+ ) , testCase "trigger ePipe exception" $ bracket ( do server <- socket :: IO (Socket Inet Stream TCP)@@ -403,6 +432,19 @@ ] ] +group98 :: TestTree+group98 = testGroup "getAddress" [++ testCase "getAddress after bind" $ bracket+ ( socket :: IO (Socket Inet Stream Default) ) close+ ( \s -> do+ let addr = SocketAddressInet (inetAddressFromTuple (127,0,0,1)) 8080+ bind s addr+ addr' <- getAddress s+ assertEqual "" addr' addr+ )+ ]+ group99 :: TestTree group99 = testGroup "getAddrInfo" [ @@ -421,7 +463,7 @@ , 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" ]