packages feed

socket 0.2.0.0 → 0.3.0.1

raw patch · 35 files changed

+1533/−967 lines, 35 filesdep ~base

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,3 +1,36 @@+0.3.0.1 Lars Petersen <info@lars-petersen.net> 2015-06-07++ * Fixed documentation of eaiNONAME.+ * Fixed typo in .cabal file in reference to cbits file.++0.3.0.0 Lars Petersen <info@lars-petersen.net> 2015-06-07++ * `AddrInfoFlags` and `NameInfoFlags` are now instances of `Bits`.+ * Dropped all sendmsg/recvmsg related operations (harden the core first!)+ * Dropped support for UNIX socket (will be separate package `socket-unix`)+ * Renamed type function `Address` to `SockAddr`.+ * Added GetAddrInfo and GetNameInfo classes.+ * Dropped support for SCTP (will be separate package `socket-sctp`)+ * Added support for RAW sockets.+ * Started to support Windows (still unfinished).+ * New operation `recvRecord`.+ * ReceiveMsg now returns a strict `ByteString`.+ * New operations `sendV`, `sendToV`.+ * Restricted getAddrInfo and getNameInfo and added `getAddrInfo6` and+   `getNameInfo6`+ * Added address family types INET, INET6 and UNIX (API breaking change)+ * Hide `SockAddrIn6` address constructor+ * Hide `SockAddrIn` address constructor+ * Added `recvMsg` operation+ * Fixed unsafeSend, unsafeSendTo and unsafeSendMsg (they were waiting for+   a read event instead of waiting for writing)+ * Use `aiStrError` values in Show instance+ * Added `aiStrError` function+ * Added constants for AddrInfoException+ * Changed definitin of AddrInfoException+ * Added `sendAllMsg` operation+ * Added `sendMsg` operation (+ some types and internals)+ 0.2.0.0 Lars Petersen <info@lars-petersen.net> 2015-05-29   * Added a sendAll operation
README.md view
@@ -7,7 +7,52 @@  ### Motivation -   - Have a typesafe and easy-to-use binding to all kinds of Posix sockets.+This library aims to expose a minimal and platform-independant interface for+POSIX compliant networking code.++### Implementation Philosophy++  - Every operation and every flag exposed should be supported with same+    semantics on every platform. If this cannot be guaranteed it should+    be supplied by another (extension) package.+    Examples for things that have been ripped out of this library are:+      - Support for Unix sockets which don't have an equivalent on Windows.+      - Support for SCTP.+      - Support for vectored IO (at least unless it can be guaranteed to+        be supported on all platforms).++  - Absolutely no conditional exports.++  - No `#ifdef` madness in the Haskell sources. The Haskell binding code+    uses the FFI to reference the platform's native networking functions.+    If they are not Posix compliant (i.e. under Windows) an level of+    indirection is introduced to write an Posix compliant equivalent in C+    using whatever the plaform specific building blocks are.++### Platform Support++#### Linux++Working.++#### BSD++Unknown. Should work. Please report if not.++#### MacOS++Unknown. Please report if you have a Mac.++#### Windows++Unfinished (problem with non-blocking IO).++Aim: Support Windows7 or higher. Don't have dependencies on autotools, just+Haskell Platform with MinGW should suffice.++#### Android++Unknown. Should be supported. Please get in touch if you plan to use it.  ### Dependencies 
+ cbits/hs_socket_posix.c view
@@ -0,0 +1,14 @@+#include <hs_socket.h>++int hs_setnonblocking(int fd) {+  int flags;++  if (-1 == (flags = fcntl(fd, F_GETFL, 0))) {+        flags = 0;+  }+  return fcntl(fd, F_SETFL, flags | O_NONBLOCK);+}++int hs_get_last_socket_error(void) {+  return errno;+};
+ cbits/hs_socket_win32.c view
@@ -0,0 +1,126 @@+#include <hs_socket.h>++int hs_socket_init() {+  static int has_already_been_initialised = 0;++  if (!has_already_been_initialised) {+    WSADATA wsaData;++    int ini = WSAStartup(MAKEWORD(2,2), &wsaData);+    if (ini != NO_ERROR) {+      WSACleanup();+      return -1;+    } else {+      has_already_been_initialised = 1;+    }+  }+  return 0;+};++int hs_socket(int domain, int type, int protocol) {+  if (hs_socket_init() != 0) {+    return -1;+  }++  return socket(domain, type, protocol);+};++int hs_bind(int sockfd, const struct sockaddr *name, int namelen) {+  return bind(sockfd, name, namelen);+};++int hs_connect(int sockfd, const struct sockaddr *name, int namelen) {+  int i = connect(sockfd, name, namelen);+  if (i != 0) {+    switch (WSAGetLastError()) {+      case WSAEWOULDBLOCK:+        return 0;+        break;+      // TODO: remap other error codes that don't behave the posix way.+      default:+        break;+    }+  }+  return i;+};++int hs_listen (int sockfd, int backlog) {+  return listen(sockfd, backlog);+};++int hs_accept(int sockfd, struct sockaddr *addr, int *addrlen) {+  return accept(sockfd, addr, addrlen);+}++int hs_close(int sockfd) {+  return closesocket(sockfd);+};++int hs_setnonblocking(int fd) {+  // If iMode = 0, blocking is enabled; +  // If iMode != 0, non-blocking mode is enabled.+  u_long iMode = 1;+  //return ioctlsocket(fd, FIONBIO, &iMode);+  return 0;+};++int hs_send    (int sockfd, const void *buf, size_t len, int flags) {+  printf("send1");+  int x = send(sockfd, buf, len, flags);+  printf("send2\n");+  printf("%ld\n", x);+  return x;+};++int hs_recv    (int sockfd,       void *buf, size_t len, int flags) {+  return -1;+};++int hs_sendto  (int sockfd, const void *buf, size_t len, int flags,+                const struct sockaddr *dest_addr, int addrlen) {+  return -1;+};++int hs_recvfrom(int sockfd,       void *buf, size_t len, int flags,+                      struct sockaddr *src_addr, int *addrlen) {+  return -1;+};++int hs_get_last_socket_error(void) {+  return WSAGetLastError();+};++int hs_getsockopt(int sockfd, int level, int option_name,       void *option_value, int *option_len) {+  return getsockopt(sockfd, level, option_name, option_value, option_len);+};++int hs_setsockopt(int sockfd, int level, int option_name, const void *option_value, int  option_len) {+  return setsockopt(sockfd, level, option_name, option_value, option_len);+};++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) {+  if (hs_socket_init() != 0) {+    return -1;+  }+  return getaddrinfo(node, service, hints, res);+};++int  hs_getnameinfo(const struct sockaddr *sa, int salen,+                    char *host, int hostlen,+                    char *serv, int servlen, int flags) {+  if (hs_socket_init() != 0) {+    return -1;+  }+  return getnameinfo(sa, salen, host, hostlen, serv, servlen, flags);+};++void hs_freeaddrinfo(struct addrinfo *res) {+  freeaddrinfo(res);+  return;+};
− cbits/misc.c
@@ -1,13 +0,0 @@-#include <stdint.h>-#include <fcntl.h>-#include <sys/socket.h>-#include <netinet/in.h>--int setnonblocking(int fd) {-  int flags;--  if (-1 == (flags = fcntl(fd, F_GETFL, 0))) {-        flags = 0;-  }-  return fcntl(fd, F_SETFL, flags | O_NONBLOCK);-}
+ include/hs_socket.h view
@@ -0,0 +1,65 @@+#ifndef _HS_SOCKET+#define _HS_SOCKET++#if defined(_WIN32)++#include <hs_socket_win32.h>++#else++#include <hs_socket_posix.h>++#endif /* defined(_WIN32) */++/* Flags (by convention) get defined 0 if they are not defined+   on the system. This has to be checked for in the application.+   This is the price to pay for not having conditionally defined+   symbols on different systems.+*/++#ifndef MSG_EOR+#define MSG_EOR 0+#endif++#ifndef MSG_NOSIGNAL+#define MSG_NOSIGNAL 0+#endif++#ifndef MSG_WAITALL+#define MSG_WAITALL 0+#endif++#ifndef MSG_MORE+#define MSG_MORE 0+#endif++#ifndef MSG_TRUNC+#define MSG_TRUNC 0+#endif++#ifndef MSG_DONTWAIT+#define MSG_DONTWAIT 0+#endif++#ifndef EAI_SYSTEM+#define EAI_SYSTEM 0+#endif++#ifndef AI_ADDRCONFIG+#define AI_ADDRCONFIG 0+#endif++#ifndef AI_ALL+#define AI_ALL 0+#endif++#ifndef AI_NUMERICSERV+#define AI_NUMERICSERV 0+#endif++#ifndef AI_V4MAPPED+#define AI_V4MAPPED 0+#endif++#endif /* _HS_SOCKET */+
+ include/hs_socket_posix.h view
@@ -0,0 +1,24 @@+#include <stdint.h>+#include <fcntl.h>+#include <errno.h>++#include "sys/types.h"+#include "sys/socket.h"+#include "sys/un.h"+#include "netinet/in.h"+#include "netdb.h"++/* SocketException */++int hs_setnonblocking(int fd);+int hs_get_last_socket_error(void);++#define SEOK                   0+#define SEINTR                 EINTR+#define SEAGAIN                EAGAIN+#define SEWOULDBLOCK           EWOULDBLOCK+#define SEBADF                 EBADF+#define SEINVAL                EINVAL+#define SEINPROGRESS           EINPROGRESS+#define SEPROTONOSUPPORT       EPROTONOSUPPORT+#define SECONNREFUSED          ECONNREFUSED
+ include/hs_socket_win32.h view
@@ -0,0 +1,60 @@+#include <stdint.h>+#include <stdio.h>+#include <winsock2.h>++#ifndef _WIN32_WINNT+#define _WIN32_WINNT 0x0501+#endif+#if (_WIN32_WINNT < 0x0501)+#undef _WIN32_WINNT+#define _WIN32_WINNT 0x0501+#endif++#include <ws2tcpip.h>++int hs_setnonblocking(int fd);++int hs_socket_init();++int hs_socket  (int domain, int type, int protocol);+int hs_bind    (int sockfd, const struct sockaddr *name, int namelen);+int hs_connect (int sockfd, const struct sockaddr *name, int namelen);+int hs_listen  (int sockfd, int backlog);+int hs_accept  (int sockfd, struct sockaddr *addr, int *addrlen);+int hs_close   (int sockfd);++int hs_send    (int sockfd, const void *buf, size_t len, int flags);+int hs_recv    (int sockfd,       void *buf, size_t len, int flags);+int hs_sendto  (int sockfd, const void *buf, size_t len, int flags,+                const struct sockaddr *dest_addr, int addrlen);+int hs_recvfrom(int sockfd,       void *buf, size_t len, int flags,+                      struct sockaddr *src_addr, int *addrlen);++int hs_getsockopt(int sockfd, int level, int option_name,       void *option_value, int *option_len);+int hs_setsockopt(int sockfd, int level, int option_name, const void *option_value, int  option_len);++int  hs_getaddrinfo(const char *node, const char *service,+                    const struct addrinfo *hints,+                    struct addrinfo **res);++int  hs_getnameinfo(const struct sockaddr *sa, int salen,+                    char *host, int hostlen,+                    char *serv, int servlen, int flags);++void hs_freeaddrinfo(struct addrinfo *res);++const char *hs_gai_strerror(int errcode);++/* SocketException */++int hs_get_last_socket_error(void);++#define SEOK                   0+#define SEINTR                 WSAEINTR+#define SEAGAIN                WSATRY_AGAIN+#define SEWOULDBLOCK           WSAEWOULDBLOCK+#define SEBADF                 WSAEBADF+#define SEINVAL                WSAEINVAL+#define SEINPROGRESS           WSAEINPROGRESS+#define SEPROTONOSUPPORT       WSAEPROTONOSUPPORT+#define SECONNREFUSED          WSAECONNREFUSED
− include/misc.h
@@ -1,5 +0,0 @@-#include <stdint.h>-#include <sys/socket.h>-#include <netinet/in.h>--int setnonblocking(int fd);
socket.cabal view
@@ -1,17 +1,52 @@ name:                socket-version:             0.2.0.0-synopsis:            A binding to the POSIX sockets interface+version:             0.3.0.1+synopsis:            A portable and extensible sockets library. description:-  This package provides access to the system's socket interface with POSIX semantics.+  __Motivation__   .-  The library is designed to be threadsafe and establishes a thin layer on-  top of the underlying ccalls to help with the development of concurrent applications.-  It integrates with GHC's event management mechanism (which itself uses epoll,-  libev or similar) and makes all functions have blocking semantics-  without actually blocking the runtime system.+  This library aims to expose a minimal and platform-independant interface for+  POSIX compliant networking code.   .-  This is a community project :-) Don't hesitate to request features on the-  issue tracker or even implement some and send a pull request.+  __Implementation Philosophy__+  .+    - Every operation and every flag exposed should be supported with same+      semantics on every platform. If this cannot be guaranteed it should+      be supplied by another (extension) package.+      Examples for things that have been ripped out of this library are:+      Unix sockets, SCTP, vectored IO (for now).+  .+    - Absolutely no conditional export.+  .+    - No `#ifdef` madness in the Haskell sources. The Haskell binding code+      uses the FFI to reference the platform's native networking functions.+      If they are not Posix compliant (i.e. under Windows) an level of+      indirection is introduced to write an Posix compliant equivalent in C+      using whatever the plaform specific building blocks are.+  .+  __Platform Support__+  .+  /Linux/+  .+  Working.+  .+  /BSD/+  .+  Unknown. Should work. Please report if not.+  .+  /MacOS/+  .+  Unknown. Please report if you have a Mac.+  .+  /Windows/+  .+  Unfinished (problem with non-blocking IO).+  .+  Aim: Support Windows7 or higher. Don't have dependencies on autotools, just+  Haskell Platform with MinGW should suffice.+  .+  /Android/+  .+  Unknown. Should be supported. Please get in touch if you plan to use it. license:             MIT license-file:        LICENSE author:              Lars Petersen@@ -22,28 +57,33 @@ homepage:            https://github.com/lpeterse/haskell-socket bug-reports:         https://github.com/lpeterse/haskell-socket/issues tested-with:         GHC==7.10.1, GHC==7.8.3-extra-source-files:  README.md CHANGELOG.md+extra-source-files:  README.md+                     CHANGELOG.md+                     include/hs_socket.h+                     include/hs_socket_win32.h+                     include/hs_socket_posix.h+                     cbits/hs_socket_win32.c+                     cbits/hs_socket_posix.c  library   exposed-modules:     System.Socket-                     , System.Socket.Address-                     , System.Socket.Address.SockAddrUn-                     , System.Socket.Address.SockAddrIn-                     , System.Socket.Address.SockAddrIn6+                     , System.Socket.Family+                     , System.Socket.Family.INET+                     , System.Socket.Family.INET6                      , System.Socket.Type+                     , System.Socket.Type.RAW                      , System.Socket.Type.DGRAM                      , System.Socket.Type.STREAM                      , System.Socket.Type.SEQPACKET                      , System.Socket.Protocol                      , System.Socket.Protocol.UDP                      , System.Socket.Protocol.TCP-                     , System.Socket.Protocol.SCTP                      , System.Socket.Unsafe   other-modules:       System.Socket.Internal.FFI                      , System.Socket.Internal.Event                      , System.Socket.Internal.Socket                      , System.Socket.Internal.Exception-                     , System.Socket.Internal.MsgFlags+                     , System.Socket.Internal.Msg                      , System.Socket.Internal.AddrInfo   build-depends:       base >= 4.7 && < 5                      , bytestring < 0.11@@ -51,11 +91,87 @@   build-tools:         hsc2hs   default-language:    Haskell2010   ghc-options:         -Wall-  c-sources:         cbits/misc.c-  include-dirs:      include-  includes:          misc.h-  install-includes:  misc.h +  include-dirs:        include+  install-includes:    hs_socket.h+  if os(windows)+    c-sources:         cbits/hs_socket_win32.c+    extra-libraries:   ws2_32+    cpp-options:       -DFFI_SOCKET="hs_socket"+                       -DFFI_SOCKET_SAFETY=safe+                       -DFFI_BIND="hs_bind"+                       -DFFI_BIND_SAFETY=safe+                       -DFFI_LISTEN="hs_listen"+                       -DFFI_LISTEN_SAFETY=safe+                       -DFFI_CLOSE="hs_close"+                       -DFFI_CLOSE_SAFETY=safe+                       -DFFI_ACCEPT="hs_accept"+                       -DFFI_ACCEPT_SAFETY=safe+                       -DFFI_CONNECT="hs_connect"+                       -DFFI_CONNECT_SAFETY=safe+                       -DFFI_SEND="hs_send"+                       -DFFI_SEND_SAFETY=safe+                       -DFFI_SENDTO="hs_sendto"+                       -DFFI_SENDTO_SAFETY=safe+                       -DFFI_SENDMSG="hs_sendmsg"+                       -DFFI_SENDMSG_SAFETY=safe+                       -DFFI_RECV="hs_recv"+                       -DFFI_RECV_SAFETY=safe+                       -DFFI_RECVFROM="hs_recvfrom"+                       -DFFI_RECVFROM_SAFETY=safe+                       -DFFI_RECVMSG="hs_recvmsg"+                       -DFFI_RECVMSG_SAFETY=safe+                       -DFFI_GETSOCKOPT="hs_getsockopt"+                       -DFFI_GETSOCKOPT_SAFETY=safe+                       -DFFI_SETSOCKOPT="hs_setsockopt"+                       -DFFI_SETSOCKOPT_SAFETY=safe+                       -DFFI_GETADDRINFO="hs_getaddrinfo"+                       -DFFI_GETADDRINFO_SAFETY=safe+                       -DFFI_FREEADDRINFO="hs_freeaddrinfo"+                       -DFFI_FREEADDRINFO_SAFETY=unsafe+                       -DFFI_GETNAMEINFO="hs_getnameinfo"+                       -DFFI_GETNAMEINFO_SAFETY=safe+                       -DFFI_GAI_STRERROR="hs_gai_strerror"+                       -DFFI_GAI_STRERROR_SAFETY=unsafe+  else+    c-sources:         cbits/hs_socket_posix.c+    cpp-options:       -DFFI_SOCKET="socket"+                       -DFFI_SOCKET_SAFETY=unsafe+                       -DFFI_BIND="bind"+                       -DFFI_BIND_SAFETY=unsafe+                       -DFFI_LISTEN="listen"+                       -DFFI_LISTEN_SAFETY=unsafe+                       -DFFI_CLOSE="close"+                       -DFFI_CLOSE_SAFETY=unsafe+                       -DFFI_ACCEPT="accept"+                       -DFFI_ACCEPT_SAFETY=unsafe+                       -DFFI_CONNECT="connect"+                       -DFFI_CONNECT_SAFETY=unsafe+                       -DFFI_SEND="send"+                       -DFFI_SEND_SAFETY=unsafe+                       -DFFI_SENDTO="sendto"+                       -DFFI_SENDTO_SAFETY=unsafe+                       -DFFI_SENDMSG="sendmsg"+                       -DFFI_SENDMSG_SAFETY=unsafe+                       -DFFI_RECV="recv"+                       -DFFI_RECV_SAFETY=unsafe+                       -DFFI_RECVFROM="recvfrom"+                       -DFFI_RECVFROM_SAFETY=unsafe+                       -DFFI_RECVMSG="recvmsg"+                       -DFFI_RECVMSG_SAFETY=unsafe+                       -DFFI_GETSOCKOPT="getsockopt"+                       -DFFI_GETSOCKOPT_SAFETY=unsafe+                       -DFFI_SETSOCKOPT="setsockopt"+                       -DFFI_SETSOCKOPT_SAFETY=unsafe+                       -DFFI_GETADDRINFO="getaddrinfo"+                       -DFFI_GETADDRINFO_SAFETY=safe+                       -DFFI_FREEADDRINFO="freeaddrinfo"+                       -DFFI_FREEADDRINFO_SAFETY=unsafe+                       -DFFI_GETNAMEINFO="getnameinfo"+                       -DFFI_GETNAMEINFO_SAFETY=safe+                       -DFFI_GAI_STRERROR="gai_strerror"+                       -DFFI_GAI_STRERROR_SAFETY=unsafe+ test-suite basic   hs-source-dirs:      tests   main-is:             Basic.hs@@ -65,6 +181,15 @@                      , bytestring < 0.11                      , socket                      , async++test-suite AddrInfo+  hs-source-dirs:      tests+  main-is:             AddrInfo.hs+  type:                exitcode-stdio-1.0+  default-language:    Haskell2010+  build-depends:       base >= 4.7 && < 5+                     , bytestring < 0.11+                     , socket  source-repository head   type:     git
src/System/Socket.hsc view
@@ -15,6 +15,8 @@ -- > module Main where -- > -- > import System.Socket+-- > import System.Socket.Family.INET (inaddrLOOPBACK)+-- > import Data.Monoid -- > import Data.ByteString -- > import Control.Monad -- > import Control.Concurrent@@ -22,8 +24,9 @@ -- > -- > main :: IO () -- > main = do--- >   s <- socket :: IO (Socket SockAddrIn STREAM TCP)--- >   bind s (SockAddrIn 8080 (pack [127,0,0,1]))+-- >   s <- socket :: IO (Socket INET STREAM TCP)+-- >   setSockOpt s (SO_REUSEADDR True)+-- >   bind s (SockAddrIn 8080 inaddrLOOPBACK) -- >   listen s 5 -- >   forever $ do -- >     (peer,addr) <- accept s@@ -33,7 +36,7 @@ -- This downloads the [Haskell website](http://www.haskell.org) and shows how to -- handle exceptions. Note the use of IPv4-mapped IPv6 addresses: This will work -- even if you don't have IPv6 connectivity yet and is the preferred method--- when new applications.+-- when writing new applications. -- -- > {-# LANGUAGE OverloadedStrings #-} -- > module Main where@@ -63,12 +66,12 @@ -- >  -- > fetch :: IO () -- > fetch = do--- >   addrs <- getAddrInfo (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo SockAddrIn6 STREAM TCP]+-- >   addrs <- getAddrInfo6 (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP] -- >   case addrs of -- >     (addr:_) -> -- >       -- always use the `bracket` pattern to reliably release resources! -- >       bracket--- >         ( socket :: IO (Socket SockAddrIn6 STREAM TCP) )+-- >         ( socket :: IO (Socket INET6 STREAM TCP) ) -- >         ( close ) -- >         ( \s-> do connect s (addrAddress addr) -- >                   sendAll s "GET / HTTP/1.0\r\nHost: www.haskell.org\r\n\r\n" mempty@@ -85,75 +88,86 @@   -- * Name Resolution     AddrInfo (..)   -- ** getAddrInfo-  , getAddrInfo+  , GetAddrInfo (..)   -- ** getNameInfo-  , getNameInfo+  , GetNameInfo (..)   -- * Operations   -- ** socket   , socket+  -- ** connect+  , connect   -- ** bind   , bind   -- ** listen   , listen   -- ** accept   , accept-  -- ** connect-  , connect-  -- ** send-  , send-  -- ** sendAll-  , sendAll-  -- ** sendTo-  , sendTo-  -- ** recv-  , recv-  -- ** recvFrom-  , recvFrom+  -- ** send, sendTo+  , send, sendTo+  -- ** recv, recvFrom+  , recv, recvFrom   -- ** close   , close-+  -- * Convenience Operations+  -- ** sendAll+  , sendAll   -- * Sockets   , Socket (..)-  -- ** Addresses-  , Address (..)-  -- *** SockAddrIn+  -- ** Families+  , Family (..)+  -- *** INET+  , INET   , SockAddrIn (..)-  -- *** SockAddrIn6+  -- *** INET6+  , INET6   , SockAddrIn6 (..)-  -- *** SockAddrUn-  , SockAddrUn (..)   -- ** Types   , Type (..)   -- *** DGRAM   , DGRAM+  -- *** RAW+  , RAW+    -- *** SEQPACKET+  , SEQPACKET   -- *** STREAM   , STREAM-  -- *** SEQPACKET-  , SEQPACKET   -- ** Protocols   , Protocol  (..)   -- *** UDP   , UDP   -- *** TCP   , TCP-  -- *** SCTP-  , SCTP   -- * Exceptions   -- ** SocketException-  , SocketException (..)+  , module System.Socket.Internal.Exception   -- ** AddrInfoException   , AddrInfoException (..)+  , gaiStrerror+  , eaiAGAIN+  , eaiBADFLAGS+  , eaiFAIL+  , eaiFAMILY+  , eaiMEMORY+  , eaiNONAME+  , eaiSOCKTYPE+  , eaiSERVICE+  , eaiSYSTEM   -- * Options   , GetSockOpt (..)   , SetSockOpt (..)   -- ** SO_ACCEPTCONN   , SO_ACCEPTCONN (..)+    -- ** SO_REUSEADDR+  , SO_REUSEADDR (..)   -- * Flags   -- ** MsgFlags   , MsgFlags (..)+  , msgDONTWAIT   , msgEOR+  , msgMORE   , msgNOSIGNAL   , msgOOB+  , msgTRUNC   , msgWAITALL   -- ** AddrInfoFlags   , AddrInfoFlags (..)@@ -175,15 +189,17 @@  import Control.Exception import Control.Monad+import Control.Applicative import Control.Concurrent.MVar  import Data.Function+import Data.Monoid import qualified Data.ByteString as BS import qualified Data.ByteString.Unsafe as BS  import GHC.Conc (closeFdWith) -import Foreign.C.Error+import Foreign.Ptr import Foreign.Storable import Foreign.Marshal.Alloc @@ -193,64 +209,65 @@ import System.Socket.Internal.Event import System.Socket.Internal.FFI import System.Socket.Internal.Exception-import System.Socket.Internal.MsgFlags+import System.Socket.Internal.Msg import System.Socket.Internal.AddrInfo -import System.Socket.Address-import System.Socket.Address.SockAddrUn-import System.Socket.Address.SockAddrIn-import System.Socket.Address.SockAddrIn6+import System.Socket.Family+import System.Socket.Family.INET+import System.Socket.Family.INET6  import System.Socket.Type-import System.Socket.Type.STREAM import System.Socket.Type.DGRAM+import System.Socket.Type.RAW import System.Socket.Type.SEQPACKET+import System.Socket.Type.STREAM  import System.Socket.Protocol import System.Socket.Protocol.UDP import System.Socket.Protocol.TCP-import System.Socket.Protocol.SCTP -#include "sys/socket.h"+#include "hs_socket.h"  -- | Creates a new socket. -----   Whereas the underlying POSIX socket function takes 3 parameters, this library+--   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: -- --   > -- create a IPv4-UDP-datagram socket---   > sock <- socket :: IO (Socket SockAddrIn DGRAM UDP)+--   > sock <- socket :: IO (Socket INET DGRAM UDP) --   > -- create a IPv6-TCP-streaming socket---   > sock6 <- socket :: IO (Socket SockAddrIn6 STREAM TCP)+--   > sock6 <- socket :: IO (Socket INET6 STREAM TCP) -- --     - This operation sets up a finalizer that automatically closes the 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.+--       If possible, use `Control.Exception.bracket` to reliably close the+--       socket descriptor on exception or regular termination of your+--       computation:+--+--       > result <- bracket (socket :: IO (Socket INET6 STREAM TCP)) close $ \sock-> do+--       >   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:------        [@EAFNOSUPPORT@]    The socket domain is not supported.---        [@EMFILE@]          The process is out file descriptors.---        [@ENFILE@]          The system is out file descriptors.---        [@EPROTONOSUPPORT@] The socket protocol is not supported (for this socket domain).---        [@EPROTOTYPE@]      The socket type is not supported by the protocol.---        [@EACCES@]          The process is lacking necessary privileges.---        [@ENOMEM@]          Insufficient memory.-socket :: (Address a, Type t, Protocol  p) => IO (Socket a t p)+--     - This operation throws `SocketException`s. Consult your @man@ page for+--       details and specific @errno@s.+socket :: (Family f, Type t, Protocol  p) => IO (Socket f t p) socket = socket'  where-   socket' :: forall a t p. (Address a, Type t, Protocol  p) => IO (Socket a t p)+   socket' :: forall f t p. (Family f, Type t, Protocol  p) => IO (Socket f t p)    socket'  = do      bracketOnError        -- Try to acquire the socket resource. This part has exceptions masked.-       ( c_socket (addressFamilyNumber (undefined :: a)) (typeNumber (undefined :: t)) (protocolNumber (undefined :: p)) )+       ( c_socket (familyNumber (undefined :: f)) (typeNumber (undefined :: t)) (protocolNumber (undefined :: p)) )        -- On failure after the c_socket call we try to close the socket to not leak file descriptors.        -- If closing fails we cannot really do something about it. We tried at least.        -- This part has exceptions masked as well. c_close is an unsafe FFI call.@@ -258,12 +275,12 @@        -- If an exception is raised, it is reraised after the socket has been closed.        -- This part has async exceptions unmasked (via restore).        ( \fd-> if fd < 0 then do-                getErrno >>= throwIO . SocketException+                c_get_last_socket_error >>= throwIO               else do                 -- setNonBlockingFD calls c_fcntl_write which is an unsafe FFI call.                 i <- c_setnonblocking fd                 if i < 0 then do-                  getErrno >>= throwIO . SocketException+                  c_get_last_socket_error >>= throwIO                 else do                   mfd <- newMVar fd                   let s = Socket mfd@@ -271,6 +288,45 @@                   return s        ) +-- | Connects to an remote address.+--+--   - Calling `connect` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.+--   - This function returns as soon as a connection has either been established+--     or refused. A failed connection attempt does not throw an exception+--     if @EINTR@ or @EINPROGRESS@ were caught internally. The operation+--     just unblocks and returns in this case. The approach is to+--     just try to read or write the socket and eventually fail there instead.+--     Also see [these considerations](http://cr.yp.to/docs/connect.html) for an explanation.+--   - This operation throws `SocketException`s. Consult your @man@ page for+--     details and specific @errno@s.+--   - @EINTR@ and @EINPROGRESS@ get catched internally and won't be thrown as the+--     connection might still be established asynchronously. Expect failure+--     when trying to read or write the socket in this case.+connect :: Family f => Socket f t p -> SockAddr f -> IO ()+connect (Socket mfd) addr = do+  mwait <- withMVar mfd $ \fd-> do+    when (fd < 0) $ do+      throwIO eBADF+    alloca $ \addrPtr-> do+      poke addrPtr addr+      i <- c_connect fd addrPtr (fromIntegral $ sizeOf addr)+      if i < 0 then do+        e <- c_get_last_socket_error+        if e == eINPROGRESS || e == eINTR then do+          -- The manpage says that in this case the connection+          -- shall be established asynchronously and one is+          -- supposed to wait.+          wait <- threadWaitWrite' fd+          return (Just wait)+        else do+          throwIO e+      else do+        -- This should not be the case on non-blocking socket, but better safe than sorry.+        return Nothing+  case mwait of+    Just wait -> wait+    Nothing   -> return ()+ -- | Bind a socket to an address. -- --   - Calling `bind` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.@@ -279,110 +335,82 @@ --     the Posix manpage doesn't mention the last one and even MacOS' implementation will never --     fail with any of these when the socket is configured non-blocking as --     [argued here](http://stackoverflow.com/a/14485305).---   - The following `SocketException`s are relevant and might be thrown (see @man bind@ for more exceptions regarding SockAddrUn sockets):------     [@EADDRINUSE@]     The address is in use.---     [@EADDRNOTAVAIL@]  The address is not available.---     [@EBADF@]          Not a valid file descriptor.---     [@EINVAL@]         Socket is already bound and cannot be re-bound or the socket has been shut down.---     [@ENOBUFS@]        Insufficient resources.---     [@EOPNOTSUPP@]     The socket type does not support binding.---     [@EACCES@]         The address is protected and the process is lacking permission.---     [@EISCONN@]        The socket is already connected.---     [@ELOOP@]          More than {SYMLOOP_MAX} symbolic links were encountered during resolution of the pathname in address.---     [@ENAMETOOLONG@]   The length of a pathname exceeds {PATH_MAX}, or pathname resolution of a symbolic link produced an intermediate result  with  a  length  that  exceeds {PATH_MAX}.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EAFNOSUPPORT@]   The address family is invalid.---     [@ENOTSOCK@]       The file descriptor is not a socket.---     [@EINVAL@]         Address length does not match address family.-bind :: (Address a, Type t, Protocol  p) => Socket a t p -> a -> IO ()+--   - This operation throws `SocketException`s. Consult your @man@ page for+--     details and specific @errno@s.+bind :: (Family f) => Socket f t p -> SockAddr f -> IO () bind (Socket mfd) addr = do   alloca $ \addrPtr-> do     poke addrPtr addr     withMVar mfd $ \fd-> do       i <- c_bind fd addrPtr (fromIntegral $ sizeOf addr)       if i < 0-        then getErrno >>= throwIO . SocketException+        then c_get_last_socket_error >>= throwIO         else return () --- | Accept connections on a connection-mode socket.+-- | Starts listening and queueing connection requests on a connection-mode+--   socket. -----   - Calling `listen` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.+--   - Calling `listen` on a `close`d socket throws @EBADF@ 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 --     of @0@ leaves the decision to the implementation.---   - This operation throws `SocketException`s:------     [@EBADF@]          Not a valid file descriptor (only after socket has been closed).---     [@EDESTADDRREQ@]   The socket is not bound and the protocol does not support listening on an unbound socket.---     [@EINVAL@]         The socket is already connected or has been shut down.---     [@ENOTSOCK@]       The file descriptor is not a socket (should be impossible).---     [@EOPNOTSUPP@]     The protocol does not support listening.---     [@EACCES@]         The process is lacking privileges.---     [@ENOBUFS@]        Insufficient resources.-listen :: (Address a, Type t, Protocol  p) => Socket a t p -> Int -> IO ()+--   - This operation throws `SocketException`s. Consult your @man@ page for+--     details and specific @errno@s.+listen :: Socket f t p -> Int -> IO () listen (Socket ms) backlog = do   i <- withMVar ms $ \s-> do     c_listen s (fromIntegral backlog)   if i < 0 then do-    getErrno >>= throwIO . SocketException+    c_get_last_socket_error >>= throwIO   else do     return ()  -- | Accept a new connection. -----   - Calling `accept` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.+--   - Calling `accept` on a `close`d socket throws @EBADF@ even if the former+--     file descriptor has been reassigned. --   - This operation configures the new socket non-blocking (TODO: use `accept4` if available).---   - This operation sets up a finalizer for the new socket that automatically closes the 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+--   - 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 catches @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ internally and retries automatically.---   - This operation throws `SocketException`s:------     [@EBADF@]        Not a valid file descriptor (only after the socket has been closed).---     [@ECONNABORTED@] A connection has been aborted.---     [@EINVAL@]       The socket is not accepting/listening.---     [@EMFILE@]       The process is out file descriptors.---     [@ENFILE@]       The system is out file descriptors.---     [@ENOBUFS@]      No buffer space available.---     [@ENOMEM@]       Out of memory.---     [@ENOSOCK@]      Not a valid socket descriptor (should be impossible).---     [@EOPNOTSUPP@]   The socket type does not support accepting connections.---     [@EPROTO@]       Generic protocol error.-accept :: (Address a, Type t, Protocol  p) => Socket a t p -> IO (Socket a t p, a)+--   - This operation throws `SocketException`s. Consult your @man@ page for+--     details and specific @errno@s.+--   - This operation catches @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ internally+--     and retries automatically.+accept :: (Family f) => Socket f t p -> IO (Socket f t p, SockAddr f) accept s@(Socket mfd) = accept'   where-    accept' :: forall a t p. (Address a, Type t, Protocol  p) => IO (Socket a t p, a)+    accept' :: forall f t p. (Family f) => IO (Socket f t p, SockAddr f)     accept' = do       -- Allocate local (!) memory for the address.       alloca $ \addrPtr-> do         alloca $ \addrPtrLen-> do-          poke addrPtrLen (fromIntegral $ sizeOf (undefined :: a))+          poke addrPtrLen (fromIntegral $ sizeOf (undefined :: SockAddr f))           fix $ \again-> do             -- We mask asynchronous exceptions during this critical section.             ews <- withMVarMasked mfd $ \fd-> do               fix $ \retry-> do                 ft <- c_accept fd addrPtr addrPtrLen                 if ft < 0 then do-                  e <- getErrno+                  e <- c_get_last_socket_error                   if e == eWOULDBLOCK || e == eAGAIN-                    then threadWaitRead' fd >>= return . Left+                    then do+                      threadWaitRead' fd >>= return . Left                     else if e == eINTR                       -- On EINTR it is good practice to just retry.                       then retry-                      else throwIO (SocketException e)+                      else throwIO e                 -- This is the critical section: We got a valid descriptor we have not yet returned.                 else do                    i <- c_setnonblocking ft                   if i < 0 then do-                    getErrno >>= throwIO . SocketException+                    c_get_last_socket_error >>= throwIO                   else do                     -- This peek operation might be a little expensive, but I don't see an alternative.-                    addr <- peek addrPtr :: IO (a)+                    addr <- peek addrPtr :: IO (SockAddr f)                     -- newMVar is guaranteed to be not interruptible.                     mft <- newMVar ft                     -- Register a finalizer on the new socket.@@ -393,129 +421,28 @@               Left  wait -> wait >> again               Right sock -> return sock --- | Connects to an remote address.------   - Calling `connect` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.---   - This function returns as soon as a connection has either been established---     or refused. A failed connection attempt does not throw an exception---     if @EINTR@ or @EINPROGRESS@ were caught internally. The operation---     just unblocks and returns in this case. The approach is to---     just try to read or write the socket and eventually fail there instead.---     Also see [these considerations](http://cr.yp.to/docs/connect.html) for an explanation.---     @EINTR@ and @EINPROGRESS@ are handled internally and won't be thrown.---   - The following `SocketException`s are relevant and might be thrown if the---     OS was able to decide the connection request synchronously:------     [@EADDRNOTAVAIL@] The address is not available.---     [@EBADF@]         The file descriptor is invalid.---     [@ECONNREFUSED@]  The target was not listening or refused the connection.---     [@EISCONN@]       The socket is already connected.---     [@ENETUNREACH@]   The network is unreachable.---     [@ETIMEDOUT@]     The connect timed out before a connection was established.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EAFNOTSUPPORT@] Address family does not match the socket.---     [@ENOTSOCK@]      The descriptor is not a socket.---     [@EPROTOTYPE@]    The address type does not match the socket.-connect :: (Address a, Type t, Protocol  p) => Socket a t p -> a -> IO ()-connect (Socket mfd) addr = do-  mwait <- withMVar mfd $ \fd-> do-    when (fd < 0) $ do-      throwIO (SocketException eBADF)-    alloca $ \addrPtr-> do-      poke addrPtr addr-      i <- c_connect fd addrPtr (fromIntegral $ sizeOf addr)-      if i < 0 then do-        e <- getErrno-        if e == eINPROGRESS || e == eINTR then do-          -- The manpage says that in this case the connection-          -- shall be established asynchronously and one is-          -- supposed to wait.-          wait <- threadWaitWrite' fd-          return (Just wait)-        else do-          throwIO (SocketException e)-      else do-        -- This should not be the case on non-blocking socket, but better safe than sorry.-        return Nothing-  case mwait of-    Just wait -> wait-    Nothing   -> return ()- -- | Send a message on a connected socket. -----   - Calling `send` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.---   - The operation returns the number of bytes sent.---   - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't be thrown.+--   - Calling `send` on a `close`d socket throws @EBADF@ even if the former+--     file descriptor has been reassigned.+--   - The operation returns the number of bytes sent. On @DGRAM@ and+--     @SEQPACKET@ sockets certain assurances on atomicity exist and @EAGAIN@ or+--     @EWOULDBLOCK@ are returned until the whole message would fit+--     into the send buffer.  --   - The flag @MSG_NOSIGNAL@ is set to supress signals which are pointless.---   - The following `SocketException`s are relevant and might be thrown:------     [@EBADF@]         The file descriptor is invalid.---     [@ECONNRESET@]    The peer forcibly closed the connection.---     [@EDESTADDREQ@]   Remote address has not been set, but is required.---     [@EMSGSIZE@]      The message is too large to be sent all at once, but the protocol requires this.---     [@ENOTCONN@]      The socket is not connected.---     [@EPIPE@]         The socket is shut down for writing or the socket is not connected anymore.---     [@EACCESS@]       The process is lacking permissions.---     [@EIO@]           An I/O error occured while writing to the filesystem.---     [@ENETDOWN@]      The local network interface is down.---     [@ENETUNREACH@]   No route to network.---     [@ENOBUFS@]       Insufficient resources to fulfill the request.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EOPNOTSUPP@]    The specified flags are not supported.---     [@ENOTSOCK@]      The descriptor does not refer to a socket.-send :: (Address a, Type t, Protocol  p) => Socket a t p -> BS.ByteString -> MsgFlags -> IO Int+--   - This operation throws `SocketException`s. Consult @man 3p send@ for+--     details and specific @errno@s.+--   - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ 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 -> MsgFlags -> IO Int send s bs flags = do   bytesSent <- BS.unsafeUseAsCStringLen bs $ \(bufPtr,bufSize)->-    unsafeSend s bufPtr (fromIntegral bufSize) flags+    unsafeSend s (castPtr bufPtr) (fromIntegral bufSize) flags   return (fromIntegral bytesSent) --- | Like `send`, but continues until all data has been sent.------   > sendAll sock data flags = do---   >   sent <- send sock data flags---   >   when (sent < length data) $ sendAll sock (drop sent data) flags-sendAll ::(Address a, Type t, Protocol  p) => Socket a t p -> BS.ByteString -> MsgFlags -> IO ()-sendAll s bs flags = do-  sent <- send s bs flags-  when (sent < BS.length bs) $ sendAll s (BS.drop sent bs) flags---- | Send a message on a socket with a specific destination address.------   - Calling `sendTo` on a `close`d socket throws @EBADF@ even if the former file descriptor has been reassigned.---   - The operation returns the number of bytes sent.---   - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't be thrown.---   - The flag @MSG_NOSIGNAL@ is set to supress signals which are pointless.---   - The following `SocketException`s are relevant and might be thrown:------     [@EBADF@]         The file descriptor is invalid.---     [@ECONNRESET@]    The peer forcibly closed the connection.---     [@EDESTADDREQ@]   Remote address has not been set, but is required.---     [@EMSGSIZE@]      The message is too large to be sent all at once, but the protocol requires this.---     [@ENOTCONN@]      The socket is not connected.---     [@EPIPE@]         The socket is shut down for writing or the socket is not connected anymore.---     [@EACCESS@]       The process is lacking permissions.---     [@EDESTADDRREQ@]  The destination address is required.---     [@EHOSTUNREACH@]  The destination host cannot be reached.---     [@EIO@]           An I/O error occured.---     [@EISCONN@]       The socket is already connected.---     [@ENETDOWN@]      The local network is down.---     [@ENETUNREACH@]   No route to the network.---     [@ENUBUFS@]       Insufficient resources to fulfill the request.---     [@ENOMEM@]        Insufficient memory to fulfill the request.---     [@ELOOP@]         @AF_UNIX@ only.---     [@ENAMETOOLONG@]  @AF_UNIX@ only.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EAFNOTSUPP@]    The address family does not match.---     [@EOPNOTSUPP@]    The specified flags are not supported.---     [@ENOTSOCK@]      The descriptor does not refer to a socket.---     [@EINVAL@]        The address len does not match.-sendTo :: (Address a, Type t, Protocol  p) => Socket a t p -> BS.ByteString -> MsgFlags -> a -> IO Int+-- | Like `send`, but allows for specifying a destination address.+sendTo ::(Family f) => Socket f t p -> BS.ByteString -> MsgFlags -> SockAddr f -> IO Int sendTo s bs flags addr = do   bytesSent <- alloca $ \addrPtr-> do     poke addrPtr addr@@ -528,22 +455,12 @@ --   - Calling `recv` on a `close`d socket throws @EBADF@ 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 recv@ for+--     details and specific @errno@s. --   - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't be thrown.---   - The following `SocketException`s are relevant and might be thrown:------     [@EBADF@]         The file descriptor is invalid.---     [@ECONNRESET@]    The peer forcibly closed the connection.---     [@ENOTCONN@]      The socket is not connected.---     [@ETIMEDOUT@]     The connection timed out.---     [@EIO@]           An I/O error occured while writing to the filesystem.---     [@ENOBUFS@]       Insufficient resources to fulfill the request.---     [@ENONMEM@]       Insufficient memory to fulfill the request.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EOPNOTSUPP@]    The specified flags are not supported.---     [@ENOTSOCK@]      The descriptor does not refer to a socket.-recv :: (Address a, Type t, Protocol  p) => Socket a t p -> Int -> MsgFlags -> IO BS.ByteString+--     For performance reasons the operation first tries a read+--     on the socket and then waits when it got @EAGAIN@ or @EWOULDBLOCK@.+recv :: Socket f t p -> Int -> MsgFlags -> IO BS.ByteString recv s bufSize flags =   bracketOnError     ( mallocBytes bufSize )@@ -553,40 +470,24 @@         BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)     ) --- | Receive a message on a socket and additionally yield the peer address.------   - Calling `recvFrom` on a `close`d socket throws @EBADF@ 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`.---   - @EAGAIN@, @EWOULDBLOCK@ and @EINTR@ and handled internally and won't be thrown.---   - The following `SocketException`s are relevant and might be thrown:------     [@EBADF@]         The file descriptor is invalid.---     [@ECONNRESET@]    The peer forcibly closed the connection.---     [@ENOTCONN@]      The socket is not connected.---     [@ETIMEDOUT@]     The connection timed out.---     [@EIO@]           An I/O error occured while writing to the filesystem.---     [@ENOBUFS@]       Insufficient resources to fulfill the request.---     [@ENONMEM@]       Insufficient memory to fulfill the request.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EOPNOTSUPP@]    The specified flags are not supported.---     [@ENOTSOCK@]      The descriptor does not refer to a socket.-recvFrom :: forall a t p. (Address a, Type t, Protocol  p) => Socket a t p -> Int -> MsgFlags -> IO (BS.ByteString, a)-recvFrom s bufSize flags =-  alloca $ \addrPtr-> do-    alloca $ \addrSizePtr-> do-      poke addrSizePtr (fromIntegral $ sizeOf (undefined :: a))-      bracketOnError-        ( mallocBytes bufSize )-        (\bufPtr-> free bufPtr )-        (\bufPtr-> do-            bytesReceived <- unsafeRecvFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr-            addr <- peek addrPtr-            bs   <- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)-            return (bs, addr)-        )+-- | Like `recv`, but additionally yields the peer address.+recvFrom :: (Family f) => Socket f t p -> Int -> MsgFlags -> IO (BS.ByteString, SockAddr f)+recvFrom = recvFrom'+  where+    recvFrom' :: forall f t p. (Family f) => Socket f t p -> Int -> MsgFlags -> IO (BS.ByteString, SockAddr f)+    recvFrom' s bufSize flags = do+      alloca $ \addrPtr-> do+        alloca $ \addrSizePtr-> do+          poke addrSizePtr (fromIntegral $ sizeOf (undefined :: SockAddr f))+          bracketOnError+            ( mallocBytes bufSize )+            (\bufPtr-> free bufPtr )+            (\bufPtr-> do+                bytesReceived <- unsafeRecvFrom s bufPtr (fromIntegral bufSize) flags addrPtr addrSizePtr+                addr <- peek addrPtr+                bs   <- BS.unsafePackMallocCStringLen (bufPtr, fromIntegral bytesReceived)+                return (bs, addr)+            )  -- | Closes a socket. --@@ -599,14 +500,9 @@ --     after the socket has been closed (`close` replaces the  --     `System.Posix.Types.Fd` in the `Control.Concurrent.MVar.MVar` with @-1@ --     to reliably avoid use-after-free situations).---   - The following `SocketException`s are relevant and might be thrown:------     [@EIO@]           An I/O error occured while writing to the filesystem.------   - The following `SocketException`s are theoretically possible, but should not occur if the library is correct:------     [@EBADF@]         The file descriptor is invalid.-close :: (Address a, Type t, Protocol  p) => Socket a t p -> IO ()+--   - This operation potentially throws `SocketException`s (only @EIO@ is+--     documented). @EINTR@ is catched internally and retried automatically, so won't be thrown.+close :: Socket f t p -> IO () close (Socket mfd) = do   modifyMVarMasked_ mfd $ \fd-> do     if fd < 0 then do@@ -623,13 +519,26 @@         ( const $ fix $ \retry-> do             i <- c_close fd             if i < 0 then do-              e <- getErrno+              e <- c_get_last_socket_error               if e == eINTR                  then retry-                else throwIO (SocketException e)+                else throwIO e             else return ()         ) fd       -- 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) +-------------------------------------------------------------------------------+-- Convenience Operations+-------------------------------------------------------------------------------++-- | Like `send`, but continues until all data has been sent.+--+--   > sendAll sock buf flags = do+--   >   sent <- send sock buf flags+--   >   when (sent < length buf) $ sendAll sock (drop sent buf) flags+sendAll ::Socket f STREAM p -> BS.ByteString -> MsgFlags -> IO ()+sendAll s bs flags = do+  sent <- send s bs flags+  when (sent < BS.length bs) $ sendAll s (BS.drop sent bs) flags
− src/System/Socket/Address.hs
@@ -1,10 +0,0 @@-{-# LANGUAGE TypeFamilies, FlexibleContexts #-}-module System.Socket.Address-  ( Address (..)-  ) where--import Foreign.C.Types-import Foreign.Storable--class (Storable a) => Address a where-  addressFamilyNumber :: a -> CInt
− src/System/Socket/Address/SockAddrIn.hsc
@@ -1,57 +0,0 @@-module System.Socket.Address.SockAddrIn-  ( SockAddrIn (..)-  ) where--import Data.Word-import Data.List-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Utils--import System.Socket.Address-import System.Socket.Internal.FFI--#include "sys/types.h"-#include "sys/socket.h"-#include "sys/un.h"-#include "netinet/in.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)--instance Address SockAddrIn where-  addressFamilyNumber _ = (#const AF_INET)--data SockAddrIn-   = SockAddrIn-     { sinPort      :: Word16-     , sinAddr      :: BS.ByteString-     } deriving (Eq, Ord)--instance Show SockAddrIn where-  show (SockAddrIn p a) =-    "\"" ++ (concat $ intersperse "." $ map show $ BS.unpack a) ++ ":" ++ show p ++ "\""--instance Storable SockAddrIn where-  sizeOf    _ = (#size struct sockaddr_in)-  alignment _ = (#alignment struct sockaddr_in)-  peek ptr    = do-    ph  <- peekByteOff       (sin_port ptr)  0  :: IO Word8-    pl  <- peekByteOff       (sin_port ptr)  1  :: IO Word8-    a   <- BS.packCStringLen (sin_addr ptr,  4) :: IO BS.ByteString-    return (SockAddrIn (fromIntegral ph * 256 + fromIntegral pl) a)-    where-      sin_port     = (#ptr struct sockaddr_in, sin_port)-      sin_addr     = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)-  poke ptr (SockAddrIn p a) = do-    c_memset ptr 0 (#const sizeof(struct sockaddr_in))-    poke        (sin_family   ptr) ((#const AF_INET) :: Word16)-    pokeByteOff (sin_port     ptr)  0 (fromIntegral $ rem (quot p 256) 256 :: Word8)-    pokeByteOff (sin_port     ptr)  1 (fromIntegral $ rem       p      256 :: Word8)-    BS.unsafeUseAsCString a $ \a'-> do-      copyBytes (sin_addr ptr) a' (min 4 $ BS.length a)-- copyBytes dest from count-    where-      sin_family   = (#ptr struct sockaddr_in, sin_family)-      sin_port     = (#ptr struct sockaddr_in, sin_port)-      sin_addr     = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)
− src/System/Socket/Address/SockAddrIn6.hsc
@@ -1,90 +0,0 @@-module System.Socket.Address.SockAddrIn6-  ( SockAddrIn6 (..)-  ) where--import Data.Word-import qualified Data.ByteString as BS-import qualified Data.ByteString.Unsafe as BS--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Utils--import System.Socket.Address-import System.Socket.Internal.FFI--#include "sys/types.h"-#include "sys/socket.h"-#include "sys/un.h"-#include "netinet/in.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)--instance Address SockAddrIn6 where-  addressFamilyNumber _ = (#const AF_INET6)--data SockAddrIn6-   = SockAddrIn6-     { sin6Port      :: Word16-     , sin6Flowinfo  :: Word32-     , sin6Addr      :: BS.ByteString-     , sin6ScopeId   :: Word32-     } deriving (Eq, Ord)--instance Show SockAddrIn6 where-  show (SockAddrIn6 p _ addr _) = '"':'[':(tail $ t $ BS.unpack addr)-    where-      t []       = ']':':':(show p ++ "\"")-      t [x]      = g x 0 (']':':':(show p) ++ "\"")-      t (x:y:xs) = g x y (t xs)-      g x y s    = let (a,b) = quotRem x 16-                       (c,d) = quotRem y 16-                   in  ':':(h a):(h b):(h c):(h d):s-      h :: Word8 -> Char-      h 0  = '0'-      h 1  = '1'-      h 2  = '2'-      h 3  = '3'-      h 4  = '4'-      h 5  = '5'-      h 6  = '6'-      h 7  = '7'-      h 8  = '8'-      h 9  = '9'-      h 10 = 'a'-      h 11 = 'b'-      h 12 = 'c'-      h 13 = 'd'-      h 14 = 'e'-      h 15 = 'f'-      h  _ = '_'--instance Storable SockAddrIn6 where-  sizeOf    _ = (#size struct sockaddr_in6)-  alignment _ = (#alignment struct sockaddr_in6)-  peek ptr    = do-    f   <- peek              (sin6_flowinfo ptr) :: IO Word32-    ph  <- peekByteOff       (sin6_port ptr)  0  :: IO Word8-    pl  <- peekByteOff       (sin6_port ptr)  1  :: IO Word8-    a   <- BS.packCStringLen (sin6_addr ptr, 16) :: IO BS.ByteString-    s   <- peek              (sin6_scope_id ptr) :: IO Word32-    return (SockAddrIn6 (fromIntegral ph * 256 + fromIntegral pl) f a s)-    where-      sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)-      sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)-      sin6_port     = (#ptr struct sockaddr_in6, sin6_port)-      sin6_addr     = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)-  poke ptr (SockAddrIn6 p f a s) = do-    c_memset ptr 0 (#const sizeof(struct sockaddr_in6))-    poke        (sin6_family   ptr) ((#const AF_INET6) :: Word16)-    poke        (sin6_flowinfo ptr) f-    poke        (sin6_scope_id ptr) s-    pokeByteOff (sin6_port     ptr)  0 (fromIntegral $ rem (quot p 256) 256 :: Word8)-    pokeByteOff (sin6_port     ptr)  1 (fromIntegral $ rem       p      256 :: Word8)-    BS.unsafeUseAsCString a $ \a'-> do-      copyBytes (sin6_addr ptr) a' (min 16 $ BS.length a)-- copyBytes dest from count-    where-      sin6_family   = (#ptr struct sockaddr_in6, sin6_family)-      sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)-      sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)-      sin6_port     = (#ptr struct sockaddr_in6, sin6_port)-      sin6_addr     = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)
− src/System/Socket/Address/SockAddrUn.hsc
@@ -1,46 +0,0 @@-module System.Socket.Address.SockAddrUn-  ( SockAddrUn (..)-  ) where--import Data.Word-import qualified Data.ByteString as BS--import Foreign.Ptr-import Foreign.Storable-import Foreign.Marshal.Utils--import System.Socket.Address-import System.Socket.Internal.FFI--#include "sys/types.h"-#include "sys/socket.h"-#include "sys/un.h"-#include "netinet/in.h"-#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)--instance Address SockAddrUn where-  addressFamilyNumber _ = (#const AF_UNIX)--data SockAddrUn-   = SockAddrUn-     { sunPath :: BS.ByteString-     } deriving (Eq, Ord, Show)--instance Storable SockAddrUn where-  sizeOf    _ = (#size struct sockaddr_un)-  alignment _ = (#alignment struct sockaddr_un)-  peek ptr    = do-    path <- BS.packCString (sun_path ptr) :: IO BS.ByteString-    return (SockAddrUn path)-    where-      sun_path = (#ptr struct sockaddr_un, sun_path)-  poke ptr (SockAddrUn path) = do-    c_memset ptr 0 (#const sizeof(struct sockaddr_un))-    -- useAsCString null-terminates the CString-    BS.useAsCString truncatedPath $ \cs-> do-      copyBytes (sun_path ptr) cs (BS.length truncatedPath + 1)-- copyBytes dest from count-    where-      sun_path      = (#ptr struct sockaddr_un, sun_path)-      truncatedPath = BS.take ( sizeOf (undefined :: SockAddrUn)-                              - sizeOf (undefined :: Word16)-                              - 1 ) path
+ src/System/Socket/Family.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE TypeFamilies, FlexibleContexts #-}+module System.Socket.Family+  ( Family (..)+  ) where++import Foreign.C.Types+import Foreign.Storable++class (Storable (SockAddr f)) => Family f where+  type SockAddr f+  familyNumber :: f -> CInt
+ src/System/Socket/Family/INET.hsc view
@@ -0,0 +1,129 @@+{-# LANGUAGE TypeFamilies #-}+module System.Socket.Family.INET+  ( INET+  , AddrIn ()+  , SockAddrIn (..)+  , inaddrANY+  , inaddrBROADCAST+  , inaddrNONE+  , inaddrLOOPBACK+  , inaddrUNSPEC_GROUP+  , inaddrALLHOSTS_GROUP+  , inaddrALLRTS_GROUP+  , inaddrMAXLOCAL_GROUP+  ) where++import Data.Word+import Data.List+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import Control.Applicative++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Utils++import System.Socket.Family+import System.Socket.Internal.FFI++#include "hs_socket.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++data INET++instance Family INET where+  type SockAddr INET = SockAddrIn+  familyNumber _ = (#const AF_INET)++data SockAddrIn+   = SockAddrIn+     { sinPort      :: Word16+     , sinAddr      :: AddrIn+     } deriving (Eq)++-- | 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+--   on interpreting it as a number).+--+--   Another hint: Use `System.Socket.getAddrInfo` for parsing and suppress+--   nameserver lookups:+--+--   > > getAddrInfo (Just "127.0.0.1") Nothing aiNUMERICHOST :: IO [AddrInfo SockAddrIn STREAM TCP]+--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 4, addrAddress = "127.0.0.1:0", addrCanonName = Nothing}]+newtype AddrIn+      = AddrIn BS.ByteString+      deriving (Eq)++-- | @0.0.0.0@+inaddrANY             :: AddrIn+inaddrANY              = AddrIn $ BS.pack [  0,  0,  0,  0]++-- | @255.255.255.0@+inaddrBROADCAST       :: AddrIn+inaddrBROADCAST        = AddrIn $ BS.pack [255,255,255,255]++-- | @255.255.255.0@+inaddrNONE            :: AddrIn+inaddrNONE             = AddrIn $ BS.pack [255,255,255,255]++-- | @127.0.0.1@+inaddrLOOPBACK        :: AddrIn+inaddrLOOPBACK         = AddrIn $ BS.pack [127,  0,  0,  1]++-- | @224.0.0.0@+inaddrUNSPEC_GROUP    :: AddrIn+inaddrUNSPEC_GROUP     = AddrIn $ BS.pack [224,  0,  0,  0]++-- | @224.0.0.1@+inaddrALLHOSTS_GROUP  :: AddrIn+inaddrALLHOSTS_GROUP   = AddrIn $ BS.pack [224,  0,  0,  1]++-- | @224.0.0.2@+inaddrALLRTS_GROUP    :: AddrIn+inaddrALLRTS_GROUP     = AddrIn $ BS.pack [224,  0,  0,  2]++-- | @224.0.0.255@+inaddrMAXLOCAL_GROUP  :: AddrIn+inaddrMAXLOCAL_GROUP   = AddrIn $ BS.pack [224,  0,  0,255]++instance Show SockAddrIn where+  show (SockAddrIn p a) =+    show a ++ ":" ++ show p++instance Show AddrIn where+  show (AddrIn a) =+    concat $ intersperse "." $ map show $ BS.unpack a++instance Storable AddrIn where+  sizeOf   _  = (#size      uint32_t)+  alignment _ = (#alignment uint32_t)+  peek ptr    =+    AddrIn <$> BS.packCStringLen (castPtr ptr, 4)+  poke ptr (AddrIn a) =+    BS.unsafeUseAsCString a $ \aPtr-> do+      copyBytes ptr (castPtr aPtr) (min 4 $ BS.length a)++instance Storable SockAddrIn where+  sizeOf    _ = (#size struct sockaddr_in)+  alignment _ = (#alignment struct sockaddr_in)+  peek ptr    = do+    ph  <- peekByteOff (sin_port ptr)  0 :: IO Word8+    pl  <- peekByteOff (sin_port ptr)  1 :: IO Word8+    a   <- peek        (sin_addr ptr)    :: IO AddrIn+    return (SockAddrIn (fromIntegral ph * 256 + fromIntegral pl) a)+    where+      sin_port     = (#ptr struct sockaddr_in, sin_port)+      sin_addr     = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)+  poke ptr (SockAddrIn p a) = do+    c_memset ptr 0 (#const sizeof(struct sockaddr_in))+    poke        (sin_family   ptr) ((#const AF_INET) :: Word16)+    pokeByteOff (sin_port     ptr)  0 (fromIntegral $ rem (quot p 256) 256 :: Word8)+    pokeByteOff (sin_port     ptr)  1 (fromIntegral $ rem       p      256 :: Word8)+    poke        (sin_addr     ptr) a+    where+      sin_family   = (#ptr struct sockaddr_in, sin_family)+      sin_port     = (#ptr struct sockaddr_in, sin_port)+      sin_addr     = (#ptr struct in_addr, s_addr) . (#ptr struct sockaddr_in, sin_addr)
+ src/System/Socket/Family/INET6.hsc view
@@ -0,0 +1,132 @@+{-# LANGUAGE TypeFamilies #-}+module System.Socket.Family.INET6+  ( INET6+  , AddrIn6 ()+  , SockAddrIn6 (..)+  , in6addrANY+  , in6addrLOOPBACK+  ) where++import Data.Word+import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS++import Control.Applicative++import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Utils++import System.Socket.Family+import System.Socket.Internal.FFI++#include "hs_socket.h"+#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)++data INET6++instance Family INET6 where+  type SockAddr INET6 = SockAddrIn6+  familyNumber _ = (#const AF_INET6)++data SockAddrIn6+   = SockAddrIn6+     { sin6Port      :: Word16+     , sin6Flowinfo  :: Word32+     , sin6Addr      :: AddrIn6+     , sin6ScopeId   :: Word32+     } deriving (Eq)++-- | 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+--   on interpreting it as a number).+--+--   Another hint: Use `System.Socket.getAddrInfo` for parsing and suppress+--   nameserver lookups:+--+--   > > getAddrInfo (Just "::1") Nothing aiNUMERICHOST :: IO [AddrInfo SockAddrIn6 STREAM TCP]+--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 4, addrAddress = [0000:0000:0000:0000:0000:0000:0000:0001]:0, addrCanonName = Nothing}]+newtype AddrIn6+      = AddrIn6 BS.ByteString+      deriving (Eq)++-- | @::@+in6addrANY      :: AddrIn6+in6addrANY       = AddrIn6 (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0])++-- | @::1@+in6addrLOOPBACK :: AddrIn6+in6addrLOOPBACK  = AddrIn6 (BS.pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,1])++instance Show SockAddrIn6 where+  show (SockAddrIn6 p _ addr _) =+    "[" ++ show addr ++ "]:" ++ show p++instance Show AddrIn6 where+  show (AddrIn6 addr) = tail $ t $ BS.unpack addr+    where+      t []       = []+      t [x]      = g x 0 []+      t (x:y:xs) = g x y (t xs)+      g x y s    = let (a,b) = quotRem x 16+                       (c,d) = quotRem y 16+                   in  ':':(h a):(h b):(h c):(h d):s+      h :: Word8 -> Char+      h 0  = '0'+      h 1  = '1'+      h 2  = '2'+      h 3  = '3'+      h 4  = '4'+      h 5  = '5'+      h 6  = '6'+      h 7  = '7'+      h 8  = '8'+      h 9  = '9'+      h 10 = 'a'+      h 11 = 'b'+      h 12 = 'c'+      h 13 = 'd'+      h 14 = 'e'+      h 15 = 'f'+      h  _ = '_'++instance Storable AddrIn6 where+  sizeOf   _  = 16+  alignment _ = 16+  peek ptr    =+    AddrIn6 <$> BS.packCStringLen (castPtr ptr, 16)+  poke ptr (AddrIn6 a) =+    BS.unsafeUseAsCString a $ \aPtr-> do+      copyBytes ptr (castPtr aPtr) (min 16 $ BS.length a)++instance Storable SockAddrIn6 where+  sizeOf    _ = (#size struct sockaddr_in6)+  alignment _ = (#alignment struct sockaddr_in6)+  peek ptr    = do+    f   <- peek              (sin6_flowinfo ptr)     :: IO Word32+    ph  <- peekByteOff       (sin6_port     ptr)  0  :: IO Word8+    pl  <- peekByteOff       (sin6_port     ptr)  1  :: IO Word8+    a   <- peek              (sin6_addr     ptr)     :: IO AddrIn6+    s   <- peek              (sin6_scope_id ptr)     :: IO Word32+    return (SockAddrIn6 (fromIntegral ph * 256 + fromIntegral pl) f a s)+    where+      sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)+      sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)+      sin6_port     = (#ptr struct sockaddr_in6, sin6_port)+      sin6_addr     = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)+  poke ptr (SockAddrIn6 p f a s) = do+    c_memset ptr 0 (#const sizeof(struct sockaddr_in6))+    poke        (sin6_family   ptr) ((#const AF_INET6) :: Word16)+    poke        (sin6_flowinfo ptr) f+    poke        (sin6_scope_id ptr) s+    pokeByteOff (sin6_port     ptr)  0 (fromIntegral $ rem (quot p 256) 256 :: Word8)+    pokeByteOff (sin6_port     ptr)  1 (fromIntegral $ rem       p      256 :: Word8)+    poke        (sin6_addr     ptr) a+    where+      sin6_family   = (#ptr struct sockaddr_in6, sin6_family)+      sin6_flowinfo = (#ptr struct sockaddr_in6, sin6_flowinfo)+      sin6_scope_id = (#ptr struct sockaddr_in6, sin6_scope_id)+      sin6_port     = (#ptr struct sockaddr_in6, sin6_port)+      sin6_addr     = (#ptr struct in6_addr, s6_addr) . (#ptr struct sockaddr_in6, sin6_addr)
src/System/Socket/Internal/AddrInfo.hsc view
@@ -1,9 +1,21 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables #-}+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables,+            StandaloneDeriving, FlexibleContexts, TypeFamilies, CPP,+            GeneralizedNewtypeDeriving #-} module System.Socket.Internal.AddrInfo (     AddrInfo (..)+  , GetAddrInfo (..)+  , GetNameInfo (..)   , AddrInfoException (..)-  , getAddrInfo-  , getNameInfo+  , gaiStrerror+  , eaiAGAIN+  , eaiBADFLAGS+  , eaiFAIL+  , eaiFAMILY+  , eaiMEMORY+  , eaiNONAME+  , eaiSOCKTYPE+  , eaiSERVICE+  , eaiSYSTEM   , AddrInfoFlags (..)   , aiADDRCONFIG   , aiALL@@ -34,45 +46,98 @@ import Foreign.C.String import Foreign.Marshal.Alloc -import System.Socket.Address+import System.IO.Unsafe++import System.Socket.Family+import System.Socket.Family.INET+import System.Socket.Family.INET6 import System.Socket.Type import System.Socket.Protocol import System.Socket.Internal.FFI -#include "sys/types.h"-#include "sys/socket.h"-#include "netdb.h"+#include "hs_socket.h" #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__)  ------------------------------------------------------------------------------- -- AddrInfo ------------------------------------------------------------------------------- -data AddrInfo a t p+data AddrInfo f t p    = AddrInfo      { addrInfoFlags :: AddrInfoFlags-     , addrAddress   :: a+     , addrAddress   :: SockAddr f      , addrCanonName :: Maybe BS.ByteString-     } deriving (Eq, Show)+     } +deriving instance (Eq   (SockAddr f)) => Eq   (AddrInfo f t p)+deriving instance (Show (SockAddr f)) => Show (AddrInfo f t p)+ ------------------------------------------------------------------------------- -- AddrInfoException ------------------------------------------------------------------------------- --- | Contains the error code that can be matched against and a readable---   description taken from @eia_strerr@.-data AddrInfoException-   = AddrInfoException CInt String-   deriving (Eq, Show, Typeable)+-- | Contains the error code that can be matched against. Use `gaiStrerror`+--   to get a human readable explanation of the error (show`+--   does this as well).+newtype AddrInfoException+      = AddrInfoException CInt+   deriving (Eq, Typeable) +instance Show AddrInfoException where+  show e = "AddrInfoException \"" ++ gaiStrerror e ++ "\""+ instance Exception AddrInfoException +-- | A wrapper around @gai_strerror@.+gaiStrerror :: AddrInfoException -> String+gaiStrerror (AddrInfoException e) =+  unsafePerformIO $ do+    msgPtr <- c_gai_strerror e+    peekCString msgPtr++-- | > AddrInfoException "Temporary failure in name resolution"+eaiAGAIN    :: AddrInfoException+eaiAGAIN     = AddrInfoException (#const EAI_AGAIN)++-- | > AddrInfoException "Bad value for ai_flags"+eaiBADFLAGS :: AddrInfoException+eaiBADFLAGS  = AddrInfoException (#const EAI_BADFLAGS)++-- | > AddrInfoException "Non-recoverable failure in name resolution"+eaiFAIL     :: AddrInfoException+eaiFAIL      = AddrInfoException (#const EAI_FAIL)++-- | > AddrInfoException "ai_family not supported"+eaiFAMILY   :: AddrInfoException+eaiFAMILY    = AddrInfoException (#const EAI_FAMILY)++-- | > AddrInfoException "Memory allocation failure"+eaiMEMORY   :: AddrInfoException+eaiMEMORY    = AddrInfoException (#const EAI_MEMORY)++-- | > AddrInfoException "No such host is known"+eaiNONAME   :: AddrInfoException+eaiNONAME    = AddrInfoException (#const EAI_NONAME)++-- | > AddrInfoException "Servname not supported for ai_socktype"+eaiSERVICE  :: AddrInfoException+eaiSERVICE   = AddrInfoException (#const EAI_SERVICE)++-- | > AddrInfoException "ai_socktype not supported"+eaiSOCKTYPE :: AddrInfoException+eaiSOCKTYPE  = AddrInfoException (#const EAI_SOCKTYPE)++-- | > AddrInfoException "System error"+eaiSYSTEM   :: AddrInfoException+eaiSYSTEM    = AddrInfoException (#const EAI_SYSTEM)++ -- | Use the `Data.Monoid.Monoid` instance to combine several flags: -- --   > mconcat [aiADDRCONFIG, aiV4MAPPED] newtype AddrInfoFlags       = AddrInfoFlags CInt-      deriving (Eq, Show)+      deriving (Eq, Show, Bits)  instance Monoid AddrInfoFlags where   mempty@@ -106,7 +171,7 @@ --   > mconcat [niNAMEREQD, niNOFQDN] newtype NameInfoFlags       = NameInfoFlags CInt-      deriving (Eq, Show)+      deriving (Eq, Show, Bits)  instance Monoid NameInfoFlags where   mempty@@ -134,7 +199,8 @@ niNUMERICSERV  :: NameInfoFlags niNUMERICSERV   = NameInfoFlags (#const NI_NUMERICSERV) --- | Maps names to addresses (i.e. by DNS lookup).+class (Family f) => GetAddrInfo f where+  -- | Maps names to addresses (i.e. by DNS lookup). -- --   The operation throws `AddrInfoException`s. --@@ -147,76 +213,88 @@ --   queries. If you want to connect to both IPv4 and IPV6 addresses use --   `aiV4MAPPED` and use IPv6-sockets. -----   > > getAddrInfo (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo SockAddrIn6 STREAM TCP]---   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = "[2400:cb00:2048:0001:0000:0000:6ca2:cc3c]:80", addrCanonName = Nothing}]---   > > getAddrInfo (Just "darcs.haskell.org") Nothing aiV4MAPPED :: IO [AddrInfo SockAddrIn6 STREAM TCP]---   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = "[0000:0000:0000:0000:0000:ffff:17fd:e1ad]:0", addrCanonName = Nothing}]---   > > getAddrInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddrInfo SockAddrIn6 STREAM TCP]---   > *** Exception: AddrInfoException (-2) "Name or service not known"-getAddrInfo :: (Address a, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo a t p]-getAddrInfo = getAddrInfo'+--   > > getAddrInfo (Just "www.haskell.org") (Just "80") aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]+--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [2400:cb00:2048:0001:0000:0000:6ca2:cc3c]:80, addrCanonName = Nothing}]+--   > > getAddrInfo (Just "darcs.haskell.org") Nothing aiV4MAPPED :: IO [AddrInfo INET6 STREAM TCP]+--   > [AddrInfo {addrInfoFlags = AddrInfoFlags 8, addrAddress = [0000:0000:0000:0000:0000:ffff:17fd:e1ad]:0, addrCanonName = Nothing}]+--   > > getAddrInfo (Just "darcs.haskell.org") Nothing mempty :: IO [AddrInfo INET6 STREAM TCP]+--   > *** Exception: AddrInfoException "Name or service not known"+  getAddrInfo :: (Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]++instance GetAddrInfo INET where+  getAddrInfo = getAddrInfo'++instance GetAddrInfo INET6 where+  getAddrInfo = getAddrInfo'++getAddrInfo' :: forall f t p. (Family f, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo f t p]+getAddrInfo' mnode mservice (AddrInfoFlags flags) = do+  alloca $ \resultPtrPtr-> do+    poke resultPtrPtr nullPtr+    allocaBytes (#size struct addrinfo) $ \addrInfoPtr-> do+      -- properly initialize the struct+      c_memset addrInfoPtr 0 (#const sizeof(struct addrinfo))+      poke (ai_flags addrInfoPtr) flags+      poke (ai_family addrInfoPtr) (familyNumber (undefined :: f))+      poke (ai_socktype addrInfoPtr) (typeNumber (undefined :: t))+      poke (ai_protocol addrInfoPtr) (protocolNumber (undefined :: p))+      fnode $ \nodePtr-> do+        fservice $ \servicePtr->+          bracket+            (c_getaddrinfo nodePtr servicePtr addrInfoPtr resultPtrPtr)+            (\_-> do resultPtr <- peek resultPtrPtr+                     when (resultPtr /= nullPtr) (c_freeaddrinfo resultPtr)+            )+            (\e-> if e == 0 then do+                    resultPtr <- peek resultPtrPtr+                    peekAddrInfos resultPtr+                  else do+                    throwIO (AddrInfoException e)+            )   where-    getAddrInfo' :: forall a t p. (Address a, Type t, Protocol p) => Maybe BS.ByteString -> Maybe BS.ByteString -> AddrInfoFlags -> IO [AddrInfo a t p]-    getAddrInfo' mnode mservice (AddrInfoFlags flags) = do-      alloca $ \resultPtrPtr-> do-        poke resultPtrPtr nullPtr-        allocaBytes (#size struct addrinfo) $ \addrInfoPtr-> do-          -- properly initialize the struct-          c_memset addrInfoPtr 0 (#const sizeof(struct addrinfo))-          poke (ai_flags addrInfoPtr) flags-          poke (ai_family addrInfoPtr) (addressFamilyNumber (undefined :: a))-          poke (ai_socktype addrInfoPtr) (typeNumber (undefined :: t))-          poke (ai_protocol addrInfoPtr) (protocolNumber (undefined :: p))-          fnode $ \nodePtr-> do-            fservice $ \servicePtr->-              bracket-                (c_getaddrinfo nodePtr servicePtr addrInfoPtr resultPtrPtr)-                (\_-> do resultPtr <- peek resultPtrPtr-                         when (resultPtr /= nullPtr) (c_freeaddrinfo resultPtr)-                )-                (\e-> if e == 0 then do-                        resultPtr <- peek resultPtrPtr-                        peekAddrInfos resultPtr-                      else do-                        msgPtr <- c_gaistrerror e-                        msg <- peekCString msgPtr-                        throwIO (AddrInfoException e msg)-                )-      where-        ai_flags     = (#ptr struct addrinfo, ai_flags)     :: Ptr (AddrInfo a t p) -> Ptr CInt-        ai_family    = (#ptr struct addrinfo, ai_family)    :: Ptr (AddrInfo a t p) -> Ptr CInt-        ai_socktype  = (#ptr struct addrinfo, ai_socktype)  :: Ptr (AddrInfo a t p) -> Ptr CInt-        ai_protocol  = (#ptr struct addrinfo, ai_protocol)  :: Ptr (AddrInfo a t p) -> Ptr CInt-        ai_addr      = (#ptr struct addrinfo, ai_addr)      :: Ptr (AddrInfo a t p) -> Ptr (Ptr a)-        ai_canonname = (#ptr struct addrinfo, ai_canonname) :: Ptr (AddrInfo a t p) -> Ptr CString-        ai_next      = (#ptr struct addrinfo, ai_next)      :: Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p))-        fnode = case mnode of-          Just node    -> BS.useAsCString node-          Nothing      -> \f-> f nullPtr-        fservice = case mservice of-          Just service -> BS.useAsCString service-          Nothing      -> \f-> f nullPtr-        peekAddrInfos ptr = -          if ptr == nullPtr-            then return []-            else do-              flag  <- peek (ai_flags ptr)-              addr  <- peek (ai_addr ptr) >>= peek-              cname <- do cnPtr <- peek (ai_canonname ptr)-                          if cnPtr == nullPtr-                            then return Nothing-                            else BS.packCString cnPtr >>= return . Just-              as    <- peek (ai_next ptr) >>= peekAddrInfos-              return ((AddrInfo (AddrInfoFlags flag) addr cname):as)+    ai_flags     = (#ptr struct addrinfo, ai_flags)     :: Ptr (AddrInfo a t p) -> Ptr CInt+    ai_family    = (#ptr struct addrinfo, ai_family)    :: Ptr (AddrInfo a t p) -> Ptr CInt+    ai_socktype  = (#ptr struct addrinfo, ai_socktype)  :: Ptr (AddrInfo a t p) -> Ptr CInt+    ai_protocol  = (#ptr struct addrinfo, ai_protocol)  :: Ptr (AddrInfo a t p) -> Ptr CInt+    ai_addr      = (#ptr struct addrinfo, ai_addr)      :: Ptr (AddrInfo a t p) -> Ptr (Ptr a)+    ai_canonname = (#ptr struct addrinfo, ai_canonname) :: Ptr (AddrInfo a t p) -> Ptr CString+    ai_next      = (#ptr struct addrinfo, ai_next)      :: Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p))+    fnode = case mnode of+      Just node    -> BS.useAsCString node+      Nothing      -> \f-> f nullPtr+    fservice = case mservice of+      Just service -> BS.useAsCString service+      Nothing      -> \f-> f nullPtr+    peekAddrInfos ptr = +      if ptr == nullPtr+        then return []+        else do+          flag  <- peek (ai_flags ptr)+          addr  <- peek (ai_addr ptr) >>= peek+          cname <- do cnPtr <- peek (ai_canonname ptr)+                      if cnPtr == nullPtr+                        then return Nothing+                        else BS.packCString cnPtr >>= return . Just+          as    <- peek (ai_next ptr) >>= peekAddrInfos+          return ((AddrInfo (AddrInfoFlags flag) addr cname):as)  -- | Maps addresss to readable host- and service names. -- --   The operation throws `AddrInfoException`s. -----   > > getNameInfo (SockAddrIn 80 $ pack [23,253,242,70]) mempty---   > ("haskell.org","http")-getNameInfo :: (Address a) => a -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)-getNameInfo addr (NameInfoFlags flags) =+--   > > getNameInfo (SockAddrIn 80 inaddrLOOPBACK) mempty+--   > ("localhost.localdomain","http")+class (Family f) => GetNameInfo f where+  getNameInfo :: SockAddr f -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)++instance GetNameInfo INET where+  getNameInfo = getNameInfo'++instance GetNameInfo INET6 where+  getNameInfo = getNameInfo'++getNameInfo' :: Storable a => a -> NameInfoFlags -> IO (BS.ByteString, BS.ByteString)+getNameInfo' addr (NameInfoFlags flags) =   alloca $ \addrPtr->     allocaBytes (#const NI_MAXHOST) $ \hostPtr->       allocaBytes (#const NI_MAXSERV) $ \servPtr-> do@@ -230,23 +308,20 @@           serv <- BS.packCString servPtr           return (host,serv)         else do-          msgPtr <- c_gaistrerror e-          msg <- peekCString msgPtr-          throwIO (AddrInfoException e msg)+          throwIO (AddrInfoException e)  ------------------------------------------------------------------------------- -- FFI ------------------------------------------------------------------------------- -foreign import ccall safe "netdb.h getaddrinfo"+foreign import ccall FFI_GETADDRINFO_SAFETY FFI_GETADDRINFO   c_getaddrinfo  :: CString -> CString -> Ptr (AddrInfo a t p) -> Ptr (Ptr (AddrInfo a t p)) -> IO CInt -foreign import ccall unsafe "netdb.h freeaddrinfo"+foreign import ccall FFI_FREEADDRINFO_SAFETY FFI_FREEADDRINFO   c_freeaddrinfo :: Ptr (AddrInfo a t p) -> IO () -foreign import ccall safe "netdb.h getnameinfo"+foreign import ccall FFI_GETNAMEINFO_SAFETY FFI_GETNAMEINFO   c_getnameinfo  :: Ptr a -> CInt -> CString -> CInt -> CString -> CInt -> CInt -> IO CInt -foreign import ccall unsafe "netdb.h gai_strerror"-  c_gaistrerror  :: CInt -> IO CString-+foreign import ccall FFI_GAI_STRERROR_SAFETY FFI_GAI_STRERROR+  c_gai_strerror  :: CInt -> IO CString
− src/System/Socket/Internal/Exception.hs
@@ -1,122 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module System.Socket.Internal.Exception (-    SocketException (..)-  ) where--import Control.Exception--import Data.Typeable--import Foreign.C.Error--newtype SocketException-      = SocketException Errno-  deriving Typeable--instance Exception SocketException--instance Show SocketException where-  show (SocketException e) = "SocketException " ++ strerr e-    where -      strerr errno-        | errno == eOK             = "EOK"-        | errno == e2BIG           = "E2BIG"-        | errno == eACCES          = "EACCES"-        | errno == eADDRINUSE      = "EADDRINUSE"-        | errno == eADDRNOTAVAIL   = "EADDRNOTAVAIL"-        | errno == eADV            = "EADV"-        | errno == eAFNOSUPPORT    = "EAFNOSUPPORT"-        | errno == eAGAIN          = "EAGAIN"-        | errno == eALREADY        = "EALREADY"-        | errno == eBADF           = "EBADF"-        | errno == eBADMSG         = "EBADMSG"-        | errno == eBADRPC         = "EBADRPC"-        | errno == eBUSY           = "EBUSY"-        | errno == eCHILD          = "ECHILD"-        | errno == eCOMM           = "ECOMM"-        | errno == eCONNABORTED    = "ECONNABORTED"-        | errno == eCONNREFUSED    = "ECONNREFUSED"-        | errno == eCONNRESET      = "ECONNRESET"-        | errno == eDEADLK         = "EDEADLK"-        | errno == eDESTADDRREQ    = "EDESTADDRREQ"-        | errno == eDIRTY          = "EDIRTY"-        | errno == eDOM            = "EDOM"-        | errno == eDQUOT          = "EDQUOT"-        | errno == eEXIST          = "EEXIST"-        | errno == eFAULT          = "EFAULT"-        | errno == eFBIG           = "EFBIG"-        | errno == eFTYPE          = "EFTYPE"-        | errno == eHOSTDOWN       = "EHOSTDOWN"-        | errno == eHOSTUNREACH    = "EHOSTUNREACH"-        | errno == eIDRM           = "EIDRM"-        | errno == eILSEQ          = "EILSEQ"-        | errno == eINPROGRESS     = "EINPROGRESS"-        | errno == eINTR           = "EINTR"-        | errno == eINVAL          = "EINVAL"-        | errno == eIO             = "EIO"-        | errno == eISCONN         = "EISCONN"-        | errno == eISDIR          = "EISDIR"-        | errno == eLOOP           = "ELOOP"-        | errno == eMFILE          = "EMFILE"-        | errno == eMLINK          = "EMLINK"-        | errno == eMSGSIZE        = "EMSGSIZE"-        | errno == eMULTIHOP       = "EMULTIHOP"-        | errno == eNAMETOOLONG    = "ENAMETOOLONG"-        | errno == eNETDOWN        = "ENETDOWN"-        | errno == eNETRESET       = "ENETRESET"-        | errno == eNETUNREACH     = "ENETUNREACH"-        | errno == eNFILE          = "ENFILE"-        | errno == eNOBUFS         = "ENOBUFS"-        | errno == eNODATA         = "ENODATA"-        | errno == eNODEV          = "ENODEV"-        | errno == eNOENT          = "ENOENT"-        | errno == eNOEXEC         = "ENOEXEC"-        | errno == eNOLCK          = "ENOLCK"-        | errno == eNOLINK         = "ENOLINK"-        | errno == eNOMEM          = "ENOMEM"-        | errno == eNOMSG          = "ENOMSG"-        | errno == eNONET          = "ENONET"-        | errno == eNOPROTOOPT     = "ENOPROTOOPT"-        | errno == eNOSPC          = "ENOSPC"-        | errno == eNOSR           = "ENOSR"-        | errno == eNOSTR          = "ENOSTR"-        | errno == eNOSYS          = "ENOSYS"-        | errno == eNOTBLK         = "ENOTBLK"-        | errno == eNOTCONN        = "ENOTCONN"-        | errno == eNOTDIR         = "ENOTDIR"-        | errno == eNOTEMPTY       = "ENOTEMPTY"-        | errno == eNOTSOCK        = "ENOTSOCK"-        | errno == eNOTTY          = "ENOTTY"-        | errno == eNXIO           = "ENXIO"-        | errno == eOPNOTSUPP      = "EOPNOTSUPP"-        | errno == ePERM           = "EPERM"-        | errno == ePFNOSUPPORT    = "EPFNOSUPPORT"-        | errno == ePIPE           = "EPIPE"-        | errno == ePROCLIM        = "EPROCLIM"-        | errno == ePROCUNAVAIL    = "EPROCUNAVAIL"-        | errno == ePROGMISMATCH   = "EPROGMISMATCH"-        | errno == ePROGUNAVAIL    = "EPROGUNAVAIL"-        | errno == ePROTO          = "EPROTO"-        | errno == ePROTONOSUPPORT = "EPROTONOSUPPORT"-        | errno == ePROTOTYPE      = "EPROTOTYPE"-        | errno == eRANGE          = "ERANGE"-        | errno == eREMCHG         = "EREMCHG"-        | errno == eREMOTE         = "EREMOTE"-        | errno == eROFS           = "EROFS"-        | errno == eRPCMISMATCH    = "ERPCMISMATCH"-        | errno == eRREMOTE        = "ERREMOTE"-        | errno == eSHUTDOWN       = "ESHUTDOWN"-        | errno == eSOCKTNOSUPPORT = "ESOCKTNOSUPPORT"-        | errno == eSPIPE          = "ESPIPE"-        | errno == eSRCH           = "ESRCH"-        | errno == eSRMNT          = "ESRMNT"-        | errno == eSTALE          = "ESTALE"-        | errno == eTIME           = "ETIME"-        | errno == eTIMEDOUT       = "ETIMEDOUT"-        | errno == eTOOMANYREFS    = "ETOOMANYREFS"-        | errno == eTXTBSY         = "ETXTBSY"-        | errno == eUSERS          = "EUSERS"-        | errno == eWOULDBLOCK     = "EWOULDBLOCK"-        | errno == eXDEV           = "EXDEV"-        | otherwise                = let Errno i = errno-                                     in  show i
+ src/System/Socket/Internal/Exception.hsc view
@@ -0,0 +1,55 @@+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}+module System.Socket.Internal.Exception where++import Control.Exception+import Data.Typeable+import Foreign.C.Types++#include "hs_socket.h"++newtype SocketException+      = SocketException CInt+  deriving (Typeable, Eq)++instance Exception SocketException++instance Show SocketException where+  show e@(SocketException i)+    | e == eOK             = "eOK"+    | e == eINTR           = "eINTR"+    | e == eAGAIN          = "eAGAIN"+    | e == eWOULDBLOCK     = "eWOULDBLOCK"+    | e == eBADF           = "eBADF"+    | e == eINPROGRESS     = "eINPROGRESS"+    | e == ePROTONOSUPPORT = "ePROTONOSUPPORT"+    | e == eINVAL          = "eINVAL"+    | e == eCONNREFUSED    = "eCONNREFUSED"+    | otherwise            = "SocketException " ++ show i++eOK         :: SocketException+eOK          = SocketException (#const SEOK)++eINTR       :: SocketException+eINTR        = SocketException (#const SEINTR)++eAGAIN      :: SocketException+eAGAIN       = SocketException (#const SEAGAIN)++eWOULDBLOCK :: SocketException+eWOULDBLOCK  = SocketException (#const SEWOULDBLOCK)++eBADF       :: SocketException+eBADF        = SocketException (#const SEBADF)++eINPROGRESS :: SocketException+eINPROGRESS  = SocketException (#const SEINPROGRESS)++ePROTONOSUPPORT :: SocketException+ePROTONOSUPPORT  = SocketException (#const SEPROTONOSUPPORT)++eINVAL          :: SocketException+eINVAL           = SocketException (#const SEINVAL)++eCONNREFUSED    :: SocketException+eCONNREFUSED     = SocketException (#const SECONNREFUSED)+
src/System/Socket/Internal/FFI.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} module System.Socket.Internal.FFI where  import Foreign.Ptr@@ -5,45 +6,56 @@  import System.Posix.Types ( Fd(..) ) -import System.Socket.Internal.MsgFlags+import System.Socket.Internal.Msg+import System.Socket.Internal.Exception +type CSSize+   = CInt -foreign import ccall unsafe "sys/socket.h socket"+foreign import ccall FFI_SOCKET_SAFETY FFI_SOCKET   c_socket  :: CInt -> CInt -> CInt -> IO Fd -foreign import ccall unsafe "unistd.h close"+foreign import ccall FFI_CLOSE_SAFETY FFI_CLOSE   c_close   :: Fd -> IO CInt -foreign import ccall unsafe "sys/socket.h bind"+foreign import ccall FFI_BIND_SAFETY FFI_BIND   c_bind    :: Fd -> Ptr a -> CInt -> IO CInt -foreign import ccall unsafe "sys/socket.h connect"-  c_connect :: Fd -> Ptr a -> CSize -> IO CInt+foreign import ccall FFI_CONNECT_SAFETY FFI_CONNECT+  c_connect :: Fd -> Ptr a -> CInt -> IO CInt -foreign import ccall unsafe "sys/socket.h accept"+foreign import ccall FFI_ACCEPT_SAFETY FFI_ACCEPT   c_accept  :: Fd -> Ptr a -> Ptr CInt -> IO Fd -foreign import ccall unsafe "sys/socket.h listen"+foreign import ccall FFI_LISTEN_SAFETY FFI_LISTEN   c_listen  :: Fd -> CInt -> IO CInt -foreign import ccall unsafe "sys/socket.h send"-  c_send    :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CInt+foreign import ccall FFI_SEND_SAFETY FFI_SEND+  c_send    :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize -foreign import ccall unsafe "sys/socket.h sendto"-  c_sendto  :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> CInt -> IO CInt+foreign import ccall FFI_SENDTO_SAFETY FFI_SENDTO+  c_sendto  :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> CInt -> IO CSSize -foreign import ccall unsafe "sys/socket.h recv"-  c_recv    :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CInt+foreign import ccall FFI_RECV_SAFETY FFI_RECV+  c_recv    :: Fd -> Ptr a -> CSize -> MsgFlags -> IO CSSize --- socklen_t is an int not a size_t!-foreign import ccall unsafe "sys/socket.h recvfrom"-  c_recvfrom :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> Ptr CInt -> IO CInt+foreign import ccall FFI_RECVFROM_SAFETY FFI_RECVFROM+  c_recvfrom :: Fd -> Ptr a -> CSize -> MsgFlags -> Ptr b -> Ptr CInt -> IO CSSize -foreign import ccall unsafe "sys/socket.h getsockopt"-  c_getsockopt  :: Fd -> CInt -> CInt -> Ptr a -> Ptr Int -> IO CInt+foreign import ccall FFI_GETSOCKOPT_SAFETY FFI_GETSOCKOPT+  c_getsockopt  :: Fd -> CInt -> CInt -> Ptr a -> Ptr CInt -> IO CInt -foreign import ccall unsafe "misc.h setnonblocking"+foreign import ccall FFI_SETSOCKOPT_SAFETY FFI_SETSOCKOPT+  c_setsockopt  :: Fd -> CInt -> CInt -> Ptr a -> CInt -> IO CInt++foreign import ccall unsafe "hs_setnonblocking"   c_setnonblocking :: Fd -> IO CInt -foreign import ccall unsafe "string.h memset"+foreign import ccall unsafe "hs_get_last_socket_error"+  c_get_last_socket_error :: IO SocketException++foreign import ccall unsafe "memset"   c_memset       :: Ptr a -> CInt -> CSize -> IO ()+++
+ src/System/Socket/Internal/Msg.hsc view
@@ -0,0 +1,79 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module System.Socket.Internal.Msg (+    MsgFlags (..)+  , Msg+  , IoVec+  , msgDONTWAIT+  , msgEOR+  , msgMORE+  , msgNOSIGNAL+  , msgOOB+  , msgTRUNC+  , msgWAITALL+  ) where++import Data.Bits+import Data.Monoid+import Data.Maybe+import Data.List (intersperse)++import Foreign.C.Types+import Foreign.Storable++#include "hs_socket.h"++-- | Use the `Data.Monoid.Monoid` instance to combine several flags:+--+--   > mconcat [msgNOSIGNAL, msgWAITALL]+--+--   Use the `Data.Bits.Bits` instance to check whether a flag is set:+--+--   > if flags .&. msgEOR /= mempty then ...+newtype MsgFlags+      = MsgFlags CInt+      deriving (Eq, Bits, Storable)++data Msg a t p++data IoVec++instance Monoid MsgFlags where+  mempty  = MsgFlags 0+  mappend = (.|.)++instance Show MsgFlags where+  show msg = "mconcat [" ++ y ++ "]"+    where+      x = [ if msg .&. msgEOR      /= mempty then Just "msgEOR"      else Nothing+          , if msg .&. msgNOSIGNAL /= mempty then Just "msgNOSIGNAL" else Nothing+          , if msg .&. msgOOB      /= mempty then Just "msgOOB"      else Nothing+          , if msg .&. msgWAITALL  /= mempty then Just "msgWAITALL"  else Nothing+          , if msg .&. msgTRUNC    /= mempty then Just "msgTRUNC"    else Nothing+          , if msg .&. msgMORE     /= mempty then Just "msgMORE"     else Nothing+          , if msg .&. msgDONTWAIT /= mempty then Just "msgDONTWAIT" else Nothing+          , let (MsgFlags i) = msg `xor` (mconcat [msgEOR,msgNOSIGNAL,msgOOB,msgWAITALL,msgTRUNC,msgMORE,msgDONTWAIT] .&. msg)+            in if i /= 0 then Just ("MsgFlags " ++ show i) else Nothing +          ]+      y = concat $ intersperse "," $ catMaybes x++msgEOR      :: MsgFlags+msgEOR       = MsgFlags (#const MSG_EOR)++msgNOSIGNAL :: MsgFlags+msgNOSIGNAL  = MsgFlags (#const MSG_NOSIGNAL)++msgOOB      :: MsgFlags+msgOOB       = MsgFlags (#const MSG_OOB)++msgWAITALL  :: MsgFlags+msgWAITALL   = MsgFlags (#const MSG_WAITALL)++msgTRUNC    :: MsgFlags+msgTRUNC     = MsgFlags (#const MSG_TRUNC)++msgMORE     :: MsgFlags+msgMORE      = MsgFlags (#const MSG_MORE)++msgDONTWAIT :: MsgFlags+msgDONTWAIT  = MsgFlags (#const MSG_DONTWAIT)+
− src/System/Socket/Internal/MsgFlags.hsc
@@ -1,40 +0,0 @@-module System.Socket.Internal.MsgFlags (-    MsgFlags (..)-  , msgEOR-  , msgNOSIGNAL-  , msgOOB-  , msgWAITALL-  ) where--import Data.Bits-import Data.Monoid--import Foreign.C.Types--#include "sys/socket.h"---- | Use the `Data.Monoid.Monoid` instance to combine several flags:------   > mconcat [msgNOSIGNAL, msgWAITALL]-newtype MsgFlags-      = MsgFlags CInt-      deriving (Eq, Show)--instance Monoid MsgFlags where-  mempty-    = MsgFlags 0-  mappend (MsgFlags a) (MsgFlags b)-    = MsgFlags (a .|. b)--msgEOR      :: MsgFlags-msgEOR       = MsgFlags (#const MSG_EOR)--msgNOSIGNAL :: MsgFlags-msgNOSIGNAL  = MsgFlags (#const MSG_NOSIGNAL)--msgOOB      :: MsgFlags-msgOOB       = MsgFlags (#const MSG_OOB)--msgWAITALL  :: MsgFlags-msgWAITALL   = MsgFlags (#const MSG_WAITALL)-
src/System/Socket/Internal/Socket.hsc view
@@ -3,21 +3,24 @@   , GetSockOpt (..)   , SetSockOpt (..)   , SO_ACCEPTCONN (..)+  , SO_REUSEADDR (..)   ) where  import Control.Concurrent.MVar import Control.Exception+import Control.Monad+import Control.Applicative  import Foreign.Ptr import Foreign.Storable-import Foreign.C.Error+import Foreign.C.Types import Foreign.Marshal.Alloc import System.Posix.Types  import System.Socket.Internal.FFI import System.Socket.Internal.Exception -#include "sys/socket.h"+#include "hs_socket.h"  -- | A generic socket type. Also see `socket` for details. --@@ -41,7 +44,7 @@ --     __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 d t p+newtype Socket f t p       = Socket (MVar Fd)  class GetSockOpt o where@@ -54,13 +57,47 @@    = SO_ACCEPTCONN Bool  instance GetSockOpt SO_ACCEPTCONN where-  getSockOpt (Socket mfd) = do-    withMVar mfd $ \fd->-      alloca $ \vPtr-> do-        alloca $ \lPtr-> do-          i <- c_getsockopt fd (#const SOL_SOCKET) (#const SO_ACCEPTCONN) (vPtr :: Ptr Int) (lPtr :: Ptr Int)-          if i < 0 then do-            throwIO . SocketException =<< getErrno-          else do-            v <- peek vPtr-            return $ SO_ACCEPTCONN (v == 1)+  getSockOpt s =+    SO_ACCEPTCONN <$> getSockOptBool s (#const SOL_SOCKET) (#const SO_ACCEPTCONN)++data SO_REUSEADDR+   = SO_REUSEADDR Bool++instance GetSockOpt SO_REUSEADDR where+  getSockOpt s =+    SO_REUSEADDR <$> getSockOptBool s (#const SOL_SOCKET) (#const SO_REUSEADDR)++instance SetSockOpt SO_REUSEADDR where+  setSockOpt s (SO_REUSEADDR o) =+    setSockOptBool s (#const SOL_SOCKET) (#const SO_REUSEADDR) o++-------------------------------------------------------------------------------+-- Unsafe helpers+-------------------------------------------------------------------------------++setSockOptBool :: Socket f t p -> CInt -> CInt -> Bool -> IO ()+setSockOptBool (Socket mfd) level name value = do+  withMVar mfd $ \fd->+    alloca $ \vPtr-> do+        if value+          then poke vPtr 1+          else poke vPtr 0+        i <- c_setsockopt fd level name +                          (vPtr :: Ptr CInt)+                          (fromIntegral $ sizeOf (undefined :: CInt))+        when (i < 0) $ do+          c_get_last_socket_error >>= throwIO++getSockOptBool :: Socket f t p -> CInt -> CInt -> IO Bool+getSockOptBool (Socket mfd) level name = do+  withMVar mfd $ \fd->+    alloca $ \vPtr-> do+      alloca $ \lPtr-> do+        i <- c_getsockopt fd level name +                          (vPtr :: Ptr CInt)+                          (lPtr :: Ptr CInt)+        if i < 0 then do+          c_get_last_socket_error >>= throwIO+        else do+          v <- peek vPtr+          return (v == 1)
− src/System/Socket/Protocol/SCTP.hsc
@@ -1,11 +0,0 @@-module System.Socket.Protocol.SCTP where--import System.Socket.Protocol--#include "sys/socket.h"-#include "netinet/in.h"--data SCTP--instance Protocol  SCTP where-  protocolNumber _ = (#const IPPROTO_SCTP)
src/System/Socket/Protocol/TCP.hsc view
@@ -2,8 +2,7 @@  import System.Socket.Protocol -#include "sys/socket.h"-#include "netinet/in.h"+#include "hs_socket.h"  data TCP 
src/System/Socket/Protocol/UDP.hsc view
@@ -2,8 +2,7 @@  import System.Socket.Protocol -#include "sys/socket.h"-#include "netinet/in.h"+#include "hs_socket.h"  data UDP 
src/System/Socket/Type/DGRAM.hsc view
@@ -2,8 +2,7 @@  import System.Socket.Type -#include "sys/socket.h"-#include "netinet/in.h"+#include "hs_socket.h"  data DGRAM 
+ src/System/Socket/Type/RAW.hsc view
@@ -0,0 +1,10 @@+module System.Socket.Type.RAW where++import System.Socket.Type++#include "hs_socket.h"++data RAW++instance Type RAW where+  typeNumber _ = (#const SOCK_RAW)
src/System/Socket/Type/SEQPACKET.hsc view
@@ -2,8 +2,7 @@  import System.Socket.Type -#include "sys/socket.h"-#include "netinet/in.h"+#include "hs_socket.h"  data SEQPACKET 
src/System/Socket/Type/STREAM.hsc view
@@ -2,8 +2,7 @@  import System.Socket.Type -#include "sys/socket.h"-#include "netinet/in.h"+#include "hs_socket.h"  data STREAM 
src/System/Socket/Unsafe.hsc view
@@ -1,6 +1,8 @@ module System.Socket.Unsafe (+  -- * tryWaitAndRetry+    tryWaitAndRetry   -- * unsafeSend-    unsafeSend+  , unsafeSend   -- * unsafeSendTo   , unsafeSendTo   -- * unsafeRecv@@ -12,103 +14,63 @@ import Data.Function import Data.Monoid +import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BS+import qualified Data.ByteString.Lazy as LBS+ import Control.Monad import Control.Exception import Control.Concurrent.MVar -import Foreign.C.Error import Foreign.C.Types+import Foreign.C.String import Foreign.Ptr+import Foreign.Marshal.Alloc+import Foreign.Storable  import System.Socket.Internal.Socket import System.Socket.Internal.Event import System.Socket.Internal.FFI import System.Socket.Internal.Exception-import System.Socket.Internal.MsgFlags-import System.Socket.Address-import System.Socket.Type-import System.Socket.Protocol+import System.Socket.Internal.Msg+import System.Socket.Family -#include "sys/socket.h"+import System.Posix.Types (Fd) -unsafeSend :: (Address a, Type t, Protocol  p) => Socket a t p -> Ptr b -> CSize -> MsgFlags -> IO CInt-unsafeSend (Socket mfd) bufPtr bufSize flags = do-  fix $ \again-> do-    ewb <- withMVar mfd $ \fd-> do-      when (fd < 0) $ do-        throwIO (SocketException eBADF)-      fix $ \retry-> do-        i <- c_send fd bufPtr bufSize (flags `mappend` msgNOSIGNAL)-        if (i < 0) then do-          e <- getErrno-          if e == eWOULDBLOCK || e == eAGAIN-            then threadWaitRead' fd >>= return . Left-          else if e == eINTR-            then retry-            else throwIO (SocketException e)-        -- Send succeeded. Return the bytes send.-        else return (Right i)-    case ewb of-      Left  wait          -> wait >> again-      Right bytesSent     -> return bytesSent+#include "hs_socket.h" -unsafeSendTo :: (Address a, Type t, Protocol  p) => Socket a t p -> Ptr b -> CSize -> MsgFlags -> Ptr a -> CInt -> IO CInt-unsafeSendTo (Socket mfd) bufPtr bufSize flags addrPtr addrSize = do-  fix $ \again-> do-    ewb <- withMVar mfd $ \fd-> do-      when (fd < 0) $ do-        throwIO (SocketException eBADF)-      fix $ \retry-> do-        i <- c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNOSIGNAL) addrPtr addrSize-        if (i < 0) then do-          e <- getErrno-          if e == eWOULDBLOCK || e == eAGAIN-            then threadWaitRead' fd >>= return . Left-          else if e == eINTR-            then retry-            else throwIO (SocketException e)-        -- Send succeeded. Return the bytes send.-        else return (Right i)-    case ewb of-      Left  wait          -> wait >> again-      Right bytesSent     -> return (fromIntegral bytesSent)+unsafeSend :: Socket a t p -> Ptr a -> CSize -> MsgFlags -> IO CInt+unsafeSend s bufPtr bufSize flags = do+  tryWaitAndRetry s threadWaitWrite' (\fd-> c_send fd bufPtr bufSize (flags `mappend` msgNOSIGNAL) ) -unsafeRecv :: (Address a, Type t, Protocol  p) => Socket a t p -> Ptr b -> CSize -> MsgFlags -> IO CInt-unsafeRecv (Socket mfd) bufPtr bufSize flags =-  fix $ \again-> do-    ewb <- withMVar mfd $ \fd-> do-        when (fd < 0) $ do-          throwIO (SocketException eBADF)-        fix $ \retry-> do-          i <- c_recv fd bufPtr bufSize flags-          if (i < 0) then do-            e <- getErrno-            if e == eWOULDBLOCK || e == eAGAIN then do-              threadWaitRead' fd >>= return . Left-            else if e == eINTR-              then retry-              else throwIO (SocketException e)-          else return (Right i)-    case ewb of-      Left  wait          -> wait >> again-      Right bytesReceived -> return bytesReceived+unsafeSendTo :: Socket f t p -> Ptr b -> CSize -> MsgFlags -> Ptr (SockAddr f) -> CInt -> IO CInt+unsafeSendTo s bufPtr bufSize flags addrPtr addrSize = do+  tryWaitAndRetry s threadWaitWrite' (\fd-> c_sendto fd bufPtr (fromIntegral bufSize) (flags `mappend` msgNOSIGNAL) addrPtr addrSize) -unsafeRecvFrom :: (Address a, Type t, Protocol  p) => Socket a t p -> Ptr b -> CSize -> MsgFlags -> Ptr a -> Ptr CInt -> IO CInt-unsafeRecvFrom (Socket mfd) bufPtr bufSize flags addrPtr addrSizePtr = do+unsafeRecv :: Socket a t p -> Ptr b -> CSize -> MsgFlags -> IO CInt+unsafeRecv s bufPtr bufSize flags =+  tryWaitAndRetry s threadWaitRead' (\fd-> c_recv fd bufPtr bufSize flags)++unsafeRecvFrom :: Socket f t p -> Ptr b -> CSize -> MsgFlags -> Ptr (SockAddr f) -> Ptr CInt -> IO CInt+unsafeRecvFrom s bufPtr bufSize flags addrPtr addrSizePtr = do+  tryWaitAndRetry s threadWaitRead' (\fd-> c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr)++tryWaitAndRetry :: Socket f t p -> (Fd -> IO (IO ())) -> (Fd -> IO CInt) -> IO CInt+tryWaitAndRetry (Socket mfd) getWaitAction action = do   fix $ \again-> do-    ewb <- withMVar mfd $ \fd-> do+    ewr <- withMVar mfd $ \fd-> do         when (fd < 0) $ do-          throwIO (SocketException eBADF)+          throwIO eBADF         fix $ \retry-> do-          i <- c_recvfrom fd bufPtr bufSize flags addrPtr addrSizePtr+          i <- action fd           if (i < 0) then do-            e <- getErrno+            e <- c_get_last_socket_error             if e == eWOULDBLOCK || e == eAGAIN then do-              threadWaitRead' fd >>= return . Left+              getWaitAction fd >>= return . Left             else if e == eINTR               then retry-              else throwIO (SocketException e)+              else throwIO e           else return (Right i)-    case ewb of-      Left  wait          -> wait >> again-      Right bytesReceived -> return (fromIntegral bytesReceived)+    case ewr of+      Left  wait   -> wait >> again+      Right result -> return result
+ tests/AddrInfo.hs view
@@ -0,0 +1,45 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeFamilies #-}+module Main where++import Data.Bits+import Data.Monoid+import Control.Monad+import Control.Exception+import System.Socket+import System.Socket.Family.INET+import System.Exit++main :: IO ()+main = do +  t0001+  t0002++t0001 :: IO ()+t0001 = do+  ais <- getAddrInfo+          (Just "127.0.0.1")+          (Just "http")+          aiNUMERICHOST +          `onException` p 0 :: IO [AddrInfo INET STREAM TCP]+  when (length ais /= 1) (e 1)+  let [ai] = ais+  when (addrCanonName ai /= Nothing) (e 2)+  let addr = addrAddress ai+  when (sinPort addr /= 80) (e 3)+  when (sinAddr addr /= inaddrLOOPBACK) (e 4)+  where+    p i = print ("t0001." ++ show i)+    e i = error ("t0001." ++ show i)++t0002 :: IO ()+t0002 = do+  let x = getAddrInfo+          Nothing+          Nothing+          mempty :: IO [AddrInfo INET STREAM TCP]+  eui <- tryJust (\ex@(AddrInfoException _)-> if ex == eaiNONAME then Just () else Nothing)+                 (x `onException` p 0)+  when (eui /= Left ()) (e 1)+  where+    p i = print ("t0002." ++ show i)+    e i = error ("t0002." ++ show i)
tests/Basic.hs view
@@ -1,65 +1,82 @@ {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeFamilies #-} module Main where +import Data.Bits import Data.Monoid import Data.ByteString (pack)+import qualified Data.ByteString.Lazy as LBS import Control.Monad import Control.Exception+import Control.Concurrent import Control.Concurrent.Async-import Foreign.C.Error import System.Socket+import System.Socket.Family.INET+import System.Socket.Family.INET6 import System.Exit  main :: IO () main = do -  test "test0001.01" $ test0001 (undefined :: Socket SockAddrIn  STREAM TCP) localhost-  test "test0001.02" $ test0001 (undefined :: Socket SockAddrIn6 STREAM TCP) localhost6-  test "test0001.03" $ test0001 (undefined :: Socket SockAddrIn  STREAM SCTP) localhost-  test "test0001.04" $ test0001 (undefined :: Socket SockAddrIn6 STREAM SCTP) localhost6-  test "test0002.01" $ test0002 (undefined :: Socket SockAddrIn  DGRAM  UDP) localhost-  test "test0002.02" $ test0002 (undefined :: Socket SockAddrIn6 DGRAM  UDP) localhost6+  test "test0001.01" $ test0001 (undefined :: Socket INET  STREAM TCP)  localhost+  test "test0001.02" $ test0001 (undefined :: Socket INET6 STREAM TCP)  localhost6+  test "test0002.01" $ test0002 (undefined :: Socket INET  DGRAM  UDP)  localhost+  test "test0002.02" $ test0002 (undefined :: Socket INET6 DGRAM  UDP)  localhost6 --- Test connection oriented sockets (i.e. TCP).-test0001 :: (Address a, Type t, Protocol p) => Socket a t p -> a -> IO (Either String String)-test0001 dummy addr = do-  eServer <- try (socket `asTypeOf` return dummy)-  case eServer of-    Left e@(SocketException er) -> if er == ePROTONOSUPPORT-                                     then return (Right "Protocol not supported. System dependant.")-                                     else throwIO e-    Right server -> do-      bind server addr-      listen server 5-      serverRecv <- async $ do-        (peerSock, peerAddr) <- accept server-        recv peerSock 4096 mempty-      client <- socket `asTypeOf` return server-      connect client addr-      send client helloWorld mempty-      msg <- wait serverRecv-      close server-      close client-      if (msg /= helloWorld)-        then return (Left  "Received message was bogus.")-        else return (Right "")-      where-        helloWorld = "Hello world!"+-- Test send and receive on connection oriented sockets (i.e. TCP).+test0001 :: (Family f, Type t, Protocol p) => Socket f t p -> SockAddr f -> IO (Either String String)+test0001 dummy addr =+  bracket+      ( do  server <- socket `asTypeOf` return dummy  `onException` print "E01"+            client <- socket `asTypeOf` return dummy  `onException` print "E02"+            return (server, client)+      )+      (\(server,client)-> do+            close server                              `onException` print "E03"+            close client                              `onException` print "E04"+      )+      (\(server,client)-> do+            setSockOpt server (SO_REUSEADDR True)     `onException` print "E05"+            bind server addr                          `onException` print "E06"+            listen server 5                           `onException` print "E07"+            serverRecv <- async $ do+              (peerSock, peerAddr) <- accept server   `onException` print "E08"+              recv peerSock 4096 mempty               `onException` print "E09"+            client <- socket `asTypeOf` return server `onException` print "E10"+            connect client addr                       `onException` print "E11"+            send client helloWorld mempty             `onException` print "E12"+            msg <- wait serverRecv                    `onException` print "E13"+            close server                              `onException` print "E14"+            close client                              `onException` print "E15"+            if (msg /= helloWorld)+              then return (Left  "Received message was bogus.")+              else return (Right "")+      )+  where+    helloWorld = "Hello world!"  -- Test stateless sockets (i.e. UDP).-test0002 :: (Address a, Type t, Protocol p) => Socket a t p -> a -> IO (Either String String)-test0002 dummy addr = do-  server <- socket `asTypeOf` return dummy-  bind server addr-  serverRecv <- async $ do-    recvFrom server 4096 mempty-  client <- socket `asTypeOf` return server-  sendTo client helloWorld mempty addr-  (msg,peerAddr) <- wait serverRecv-  close server-  close client-  if (msg /= helloWorld)-    then return (Left  "Received message was bogus.")-    else return (Right "")+test0002 :: (Family f, Type t, Protocol p) => Socket f t p -> SockAddr f -> IO (Either String String)+test0002 dummy addr =+  bracket+      ( do  server <- socket `asTypeOf` return dummy+            client <- socket `asTypeOf` return dummy+            return (server, client)+      )+      (\(server,client)-> do+            close server+            close client+      )+      (\(server,client)-> do+            setSockOpt server (SO_REUSEADDR True)+            bind server addr+            serverRecv <- async $ do+              recvFrom server 4096 mempty+            client <- socket `asTypeOf` return server+            sendTo client helloWorld mempty addr+            (msg,peerAddr) <- wait serverRecv+            if (msg /= helloWorld)+              then return (Left  "Received message was bogus.")+              else return (Right "")+      )   where     helloWorld = "Hello world!" @@ -67,14 +84,14 @@ localhost =   SockAddrIn   { sinPort      = 7777-  , sinAddr      = pack [127,0,0,1]+  , sinAddr      = inaddrLOOPBACK   }  localhost6 :: SockAddrIn6 localhost6 =   SockAddrIn6   { sin6Port     = 7777-  , sin6Addr     = pack [0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,1]+  , sin6Addr     = in6addrLOOPBACK   , sin6Flowinfo = 0   , sin6ScopeId  = 0   }