posix-api 0.2.0.0 → 0.2.1.0

raw patch · 9 files changed

+1115/−62 lines, 9 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• cbits/HaskellPosix.c +7/−4
• include/HaskellPosix.h +1/−0
• posix-api.cabal +1/−1
• src-linux/Posix/Socket/Platform.hsc +49/−17
• src/Linux/Socket.hs +279/−6
• src/Linux/Socket/Types.hsc +192/−4
• src/Posix/Socket.hs +328/−11
• src/Posix/Socket/Types.hsc +142/−4
• test/Main.hs +116/−15

@@ -8,14 +8,17 @@ // into pinned memory) is to use a wrapper.  ssize_t recv_offset(int socket, char *buffer, int offset, size_t length, int flags) {-  recv(socket, (void*)(buffer + offset), length, flags);+  return recv(socket, (void*)(buffer + offset), length, flags); } ssize_t send_offset(int socket, const char *buffer, int offset, size_t length, int flags) {-  send(socket, (const void*)(buffer + offset), length, flags);+  return send(socket, (const void*)(buffer + offset), length, flags); } ssize_t sendto_offset(int socket, const char *message, int offset, size_t length, int flags, const struct sockaddr *dest_addr, socklen_t dest_len){-  sendto(socket, (const void*)(message + offset), length, flags, dest_addr, dest_len);+  return sendto(socket, (const void*)(message + offset), length, flags, dest_addr, dest_len); } ssize_t recvfrom_offset(int socket, char *restrict buffer, int offset, size_t length, int flags, struct sockaddr *restrict address, socklen_t *restrict address_len) {-  recvfrom(socket, (void*)(buffer + offset), length, flags, address, address_len);+  return recvfrom(socket, (void*)(buffer + offset), length, flags, address, address_len);+}+int setsockopt_int(int socket, int level, int option_name, int option_value) {+  return setsockopt(socket,level,option_name,&option_value,sizeof(int)); }

@@ -7,5 +7,6 @@ ssize_t sendto_offset(int socket, const char *message, int offset, size_t length, int flags, const struct sockaddr *dest_addr, socklen_t dest_len); ssize_t recvfrom_offset(int socket, char *restrict buffer, int offset, size_t length, int flags, struct sockaddr *restrict address, socklen_t *restrict address_len); +int setsockopt_int(int socket, int level, int option_name, int option_value);  

@@ -1,6 +1,6 @@ cabal-version: 2.2 name: posix-api-version: 0.2.0.0+version: 0.2.1.0 synopsis: posix bindings description:   This library provides a very thin wrapper around POSIX APIs. It can be

@@ -22,18 +22,20 @@   , encodeSocketAddressUnix     -- * Decoding Socket Addresses   , decodeSocketAddressInternet+  , indexSocketAddressInternet     -- * Sizes   , sizeofSocketAddressInternet   ) where  import Control.Monad (when)-import Data.Primitive (ByteArray(..),writeByteArray,indexByteArray)+import Data.Primitive (Addr,MutableByteArray,ByteArray(..),writeByteArray,indexByteArray) import Data.Word (Word8) import Foreign.C.Types (CUShort,CInt)-import GHC.Exts (ByteArray##,State##,RealWorld,runRW##)+import GHC.Exts (ByteArray##,State##,RealWorld,runRW##,Ptr(..)) import GHC.ST (ST(..)) import Posix.Socket.Types (SocketAddress(..)) import Posix.Socket.Types (SocketAddressInternet(..),SocketAddressUnix(..))+import Foreign.Storable (peekByteOff)  import qualified Data.Primitive as PM import qualified Foreign.Storable as FS@@ -42,29 +44,39 @@ sizeofSocketAddressInternet :: CInt sizeofSocketAddressInternet = #{size struct sockaddr_in} +internalWriteSocketAddressInternet ::+     MutableByteArray s -- ^ Buffer, must have length of @sockaddr_in@+  -> SocketAddressInternet+  -> ST s ()+internalWriteSocketAddressInternet bs (SocketAddressInternet {port, address}) = do+  -- Initialize the bytearray by filling it with zeroes to ensure+  -- that the sin_zero padding that linux expects is properly zeroed.+  PM.setByteArray bs 0 #{size struct sockaddr_in} (0 :: Word8)+  -- ATM: I cannot find a way to poke AF_INET into the socket address+  -- without hardcoding the expected length (CUShort). There may be+  -- a way to use hsc2hs to convert a size to a haskell type, but+  -- I am not sure of how to do this. At any rate, I do not expect+  -- that linux will ever change the bit size of sa_family_t, so I+  -- am not too concerned.+  #{write struct sockaddr_in, sin_family} bs (#{const AF_INET} :: CUShort)+  -- The port and the address are already supposed to be in network+  -- byte order in the SocketAddressInternet data type.+  #{write struct sockaddr_in, sin_port} bs port+  #{write struct sockaddr_in, sin_addr.s_addr} bs address+ -- | Serialize a IPv4 socket address so that it may be passed to @bind@. --   This serialization is operating-system dependent. encodeSocketAddressInternet :: SocketAddressInternet -> SocketAddress-encodeSocketAddressInternet (SocketAddressInternet {port, address}) =+encodeSocketAddressInternet sockAddrInternet =   SocketAddress $ runByteArrayST $ unboxByteArrayST $ do     bs <- PM.newByteArray #{size struct sockaddr_in}-    -- Initialize the bytearray by filling it with zeroes to ensure-    -- that the sin_zero padding that linux expects is properly zeroed.-    PM.setByteArray bs 0 #{size struct sockaddr_in} (0 :: Word8)-    -- ATM: I cannot find a way to poke AF_INET into the socket address-    -- without hardcoding the expected length (CUShort). There may be-    -- a way to use hsc2hs to convert a size to a haskell type, but-    -- I am not sure of how to do this. At any rate, I do not expect-    -- that linux will ever change the bit size of sa_family_t, so I-    -- am not too concerned.-    #{write struct sockaddr_in, sin_family} bs (#{const AF_INET} :: CUShort)-    -- The port and the address are already supposed to be in network-    -- byte order in the SocketAddressInternet data type.-    #{write struct sockaddr_in, sin_port} bs port-    #{write struct sockaddr_in, sin_addr.s_addr} bs address+    internalWriteSocketAddressInternet bs sockAddrInternet     r <- PM.unsafeFreezeByteArray bs     pure r +-- | Decode a @sockaddr_in@ from a @sockaddr@ of an unknown+--   family. This returns nothing when the size of the @sockaddr@+--   is wrong or when the @sin_family@ is not @AF_INET@. decodeSocketAddressInternet :: SocketAddress -> Maybe SocketAddressInternet decodeSocketAddressInternet (SocketAddress arr) =   if PM.sizeofByteArray arr == (#{size struct sockaddr_in})@@ -78,6 +90,23 @@       else Nothing     else Nothing +-- | This is unsafe, but it is needed for the wrappers of @recvmmsg@.+-- The index uses @sockaddr_in@s as elements, not bytes. The caller of this+-- function is responsible for bounds checks. Returns the actual (non-internet)+-- socket family on a failure to parse.+indexSocketAddressInternet :: Addr -> Int -> IO (Either CInt SocketAddressInternet)+indexSocketAddressInternet addr ix = do+  fam <- #{peek struct sockaddr_in, sin_family} ptr+  if fam == (#{const AF_INET} :: CUShort)+    then do+      port <- #{peek struct sockaddr_in, sin_port} ptr+      address <- #{peek struct sockaddr_in, sin_addr.s_addr} ptr+      pure (Right (SocketAddressInternet { port, address }))+    else pure (Left (cushortToCInt fam))+  where+  !(PM.Addr offAddr) = PM.plusAddr addr (ix * (#{size struct sockaddr_in}))+  ptr = Ptr offAddr+ -- | Serialize a unix domain socket address so that it may be passed to @bind@. --   This serialization is operating-system dependent. If the path provided by --   the argument equals or exceeds the size of @sun_path@ (typically in the range 92@@ -101,6 +130,9 @@     when (sz < pathSize) $ do       PM.copyByteArray bs familySize name 0 sz     PM.unsafeFreezeByteArray bs++cushortToCInt :: CUShort -> CInt+cushortToCInt = fromIntegral  unboxByteArrayST :: ST s ByteArray -> State## s -> (## State## s, ByteArray## ##) unboxByteArrayST (ST f) s = case f s of

@@ -1,28 +1,81 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language MagicHash #-}+{-# language ScopedTypeVariables #-}+{-# language UnboxedTuples #-}+{-# language UnliftedFFITypes #-}+ module Linux.Socket-  ( -- * Types-    SocketFlags(..)+  ( -- * Functions+    uninterruptibleReceiveMultipleMessageA+  , uninterruptibleReceiveMultipleMessageB+    -- * Types+  , SocketFlags(..)+    -- * Option Names+  , LST.headerInclude     -- * Message Flags   , LST.dontWait   , LST.truncate+  , LST.controlTruncate     -- * Socket Flags   , LST.closeOnExec   , LST.nonblocking     -- * Twiddle   , applySocketFlags+    -- * UDP Header+  , LST.sizeofUdpHeader+  , LST.pokeUdpHeaderSourcePort+  , LST.pokeUdpHeaderDestinationPort+  , LST.pokeUdpHeaderLength+  , LST.pokeUdpHeaderChecksum+    -- * IPv4 Header+  , LST.sizeofIpHeader+  , LST.pokeIpHeaderVersionIhl+  , LST.pokeIpHeaderTypeOfService+  , LST.pokeIpHeaderTotalLength+  , LST.pokeIpHeaderIdentifier+  , LST.pokeIpHeaderFragmentOffset+  , LST.pokeIpHeaderTimeToLive+  , LST.pokeIpHeaderProtocol+  , LST.pokeIpHeaderChecksum+  , LST.pokeIpHeaderSourceAddress+  , LST.pokeIpHeaderDestinationAddress   ) where  import Prelude hiding (truncate) +import Control.Monad (when) import Data.Bits ((.|.))+import Data.Primitive (MutableByteArray(..),Addr(..),ByteArray(..))+import Data.Primitive (MutableUnliftedArray(..),UnliftedArray)+import Foreign.C.Error (Errno,getErrno)+import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))+import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#,Addr#,MutableArrayArray#,Int(I#))+import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#)+import GHC.IO (IO(..)) import Linux.Socket.Types (SocketFlags(..))-import Posix.Socket (Type(..))+import Posix.Socket (Type(..),MessageFlags(..),Message(Receive))+import System.Posix.Types (Fd(..),CSsize(..)) +import qualified Data.Primitive as PM+import qualified Control.Monad.Primitive as PM+import qualified Posix.Socket as S import qualified Linux.Socket.Types as LST +foreign import ccall unsafe "sys/socket.h recvmmsg"+  c_unsafe_addr_recvmmsg :: Fd+                         -> Addr# -- This addr is an array of msghdr+                         -> CUInt -- Length of msghdr array+                         -> MessageFlags 'Receive+                         -> Addr# -- Timeout+                         -> IO CSsize+ -- | Linux extends the @type@ argument of---   <http://man7.org/linux/man-pages/man2/socket.2.html socket> to accept---   flags. It is advisable to set @SOCK_CLOEXEC@ on when opening a socket---   on linux. For example, we may open a TCP Internet socket with:+--   <http://man7.org/linux/man-pages/man2/socket.2.html socket> to allow+--   setting two socket flags on socket creation: @SOCK_CLOEXEC@ and+--   @SOCK_NONBLOCK@. It is advisable to set @SOCK_CLOEXEC@ on when+--   opening a socket on linux. For example, we may open a TCP Internet+--   socket with: -- --   > uninterruptibleSocket internet (applySocketFlags closeOnExec stream) defaultProtocol --@@ -33,3 +86,223 @@ --    applySocketFlags :: SocketFlags -> Type -> Type applySocketFlags (SocketFlags s) (Type t) = Type (s .|. t)++-- | Receive multiple messages. This does not provide the socket+--   addresses or the control messages. It does not use any of the+--   input-scattering that @recvmmsg@ offers, meaning that a single+--   datagram is never split across noncontiguous memory. It supplies+--   @NULL@ for the timeout argument. All of the messages must have the+--   same maximum size. All resulting byte arrays have been explicitly+--   pinned. In addition to bytearrays corresponding to each datagram,+--   this also provides the maximum @msg_len@ that @recvmmsg@ wrote+--   back out. This is provided so that users of @MSG_TRUNC@ can detect+--   when bytes were dropped from the end of a message (although it does+--   let the user figure out which message had bytes dropped).+uninterruptibleReceiveMultipleMessageA ::+     Fd -- ^ Socket+  -> CSize -- ^ Maximum bytes per message+  -> CUInt -- ^ Maximum number of messages+  -> MessageFlags 'Receive -- ^ Flags+  -> IO (Either Errno (CUInt,UnliftedArray ByteArray))+uninterruptibleReceiveMultipleMessageA !s !msgSize !msgCount !flags = do+  bufs <- PM.unsafeNewUnliftedArray (cuintToInt msgCount)+  mmsghdrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt LST.sizeofMultipleMessageHeader)+  iovecsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt S.sizeofIOVector)+  let !mmsghdrsAddr@(Addr mmsghdrsAddr#) = PM.mutableByteArrayContents mmsghdrsBuf+  let iovecsAddr = PM.mutableByteArrayContents iovecsBuf+  initializeMultipleMessageHeadersWithoutSockAddr bufs iovecsAddr mmsghdrsAddr msgSize msgCount+  r <- c_unsafe_addr_recvmmsg s mmsghdrsAddr# msgCount flags nullAddr#+  if r > (-1)+    then do+      (_,maxMsgSz,frozenBufs) <- shrinkAndFreezeMessages msgSize 0 (cssizeToInt r) bufs mmsghdrsAddr+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray mmsghdrsBuf+      pure (Right (maxMsgSz,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray mmsghdrsBuf+      fmap Left getErrno++-- | Receive multiple messages. This is similar to+-- @uninterruptibleReceiveMultipleMessageA@. However, it also+-- provides the @sockaddr@s of the remote endpoints. These are+-- written in contiguous memory to a bytearray of length+-- @max_num_msgs * expected_sockaddr_sz@. The @sockaddr@s must+-- all be expected to be of the same length. This function+-- provides a @sockaddr@ size check that is non-zero when any+-- @sockaddr@ had a length other than the expected length.+-- This can be used to detect if the @sockaddr@ array has one or+-- more corrupt @sockaddr@s in it. All byte arrays returned by+-- this function are pinned.+--+-- The values in the returned tuple are:+--+-- * Error-checking number for @sockaddr@ size. Non-zero indicates+--   that at least one @sockaddr@ required a number of bytes other+--   than the expected number.+-- * Pinned bytearray with all of the @sockaddr@s in it as a+--   array of structures.+-- * The size of the largest message received. If @MSG_TRUNC@ is used+--   this lets the caller know if one or more messages were truncated.+-- * The message data of each message.+--+-- The @sockaddr@s bytearray and the unlifted array of messages are+-- guaranteed to have the same number of elements. +uninterruptibleReceiveMultipleMessageB ::+     Fd -- ^ Socket+  -> CInt -- ^ Expected @sockaddr@ size+  -> CSize -- ^ Maximum bytes per message+  -> CUInt -- ^ Maximum number of messages+  -> MessageFlags 'Receive -- ^ Flags+  -> IO (Either Errno (CInt,ByteArray,CUInt,UnliftedArray ByteArray))+uninterruptibleReceiveMultipleMessageB !s !expSockAddrSize !msgSize !msgCount !flags = do+  bufs <- PM.unsafeNewUnliftedArray (cuintToInt msgCount)+  mmsghdrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt LST.sizeofMultipleMessageHeader)+  iovecsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt S.sizeofIOVector)+  sockaddrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt expSockAddrSize)+  -- Linux does not require zeroing out sockaddr_in before using it,+  -- so we leave sockaddrsBuf alone after initialization.+  let sockaddrsAddr = PM.mutableByteArrayContents sockaddrsBuf+  let !mmsghdrsAddr@(Addr mmsghdrsAddr#) = PM.mutableByteArrayContents mmsghdrsBuf+  let iovecsAddr = PM.mutableByteArrayContents iovecsBuf+  initializeMultipleMessageHeadersWithSockAddr bufs iovecsAddr mmsghdrsAddr sockaddrsAddr expSockAddrSize msgSize msgCount+  r <- c_unsafe_addr_recvmmsg s mmsghdrsAddr# msgCount flags nullAddr#+  if r > (-1)+    then do+      (validation,maxMsgSz,frozenBufs) <- shrinkAndFreezeMessages msgSize expSockAddrSize (cssizeToInt r) bufs mmsghdrsAddr+      shrinkMutableByteArray sockaddrsBuf (cssizeToInt r * cintToInt expSockAddrSize)+      sockaddrs <- PM.unsafeFreezeByteArray sockaddrsBuf+      touchMutableByteArray iovecsBuf+      touchMutableByteArray mmsghdrsBuf+      touchMutableByteArray sockaddrsBuf+      pure (Right (validation,sockaddrs,maxMsgSz,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray mmsghdrsBuf+      touchMutableByteArray sockaddrsBuf+      fmap Left getErrno+++-- This sets up an array of mmsghdr. Each msghdr has msg_iov set to+-- be an array of iovec with a single element.+initializeMultipleMessageHeadersWithoutSockAddr ::+     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers+  -> Addr -- array of iovec+  -> Addr -- array of message headers+  -> CSize -- message size+  -> CUInt -- message count+  -> IO ()+initializeMultipleMessageHeadersWithoutSockAddr bufs iovecsAddr mmsgHdrsAddr msgSize msgCount =+  let go !ix !iovecAddr !mmsgHdrAddr = if ix < cuintToInt msgCount+        then do+          pokeMultipleMessageHeader mmsgHdrAddr PM.nullAddr 0 iovecAddr 1 PM.nullAddr 0 mempty 0+          initializeIOVector bufs iovecAddr msgSize ix+          go (ix + 1) (PM.plusAddr iovecAddr (cintToInt S.sizeofIOVector)) (PM.plusAddr mmsgHdrAddr (cintToInt LST.sizeofMultipleMessageHeader))+        else pure ()+   in go 0 iovecsAddr mmsgHdrsAddr++-- This sets up an array of mmsghdr. Each msghdr has msg_iov set to+-- be an array of iovec with a single element. One giant buffer with+-- space for all of the @sockaddr@s is used.+initializeMultipleMessageHeadersWithSockAddr ::+     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers+  -> Addr -- array of iovec+  -> Addr -- array of message headers+  -> Addr -- array of sockaddrs+  -> CInt -- expected sockaddr size+  -> CSize -- message size+  -> CUInt -- message count+  -> IO ()+initializeMultipleMessageHeadersWithSockAddr bufs iovecsAddr0 mmsgHdrsAddr0 sockaddrsAddr0 sockaddrSize msgSize msgCount =+  let go !ix !iovecAddr !mmsgHdrAddr !sockaddrAddr = if ix < cuintToInt msgCount+        then do+          pokeMultipleMessageHeader mmsgHdrAddr sockaddrAddr sockaddrSize iovecAddr 1 PM.nullAddr 0 mempty 0+          initializeIOVector bufs iovecAddr msgSize ix+          go (ix + 1)+            (PM.plusAddr iovecAddr (cintToInt S.sizeofIOVector))+            (PM.plusAddr mmsgHdrAddr (cintToInt LST.sizeofMultipleMessageHeader))+            (PM.plusAddr sockaddrAddr (cintToInt sockaddrSize))+        else pure ()+   in go 0 iovecsAddr0 mmsgHdrsAddr0 sockaddrsAddr0++-- Initialize a single iovec. We write the pinned byte array into+-- both the iov_base field and into an unlifted array.+initializeIOVector ::+     MutableUnliftedArray RealWorld (MutableByteArray RealWorld)+  -> Addr+  -> CSize+  -> Int+  -> IO ()+initializeIOVector bufs iovecAddr msgSize ix = do+  buf <- PM.newPinnedByteArray (csizeToInt msgSize)+  PM.writeUnliftedArray bufs ix buf+  S.pokeIOVectorBase iovecAddr (PM.mutableByteArrayContents buf)+  S.pokeIOVectorLength iovecAddr msgSize++-- Freeze a slice of the mutable byte arrays inside the unlifted array,+-- shrinking the byte arrays before doing so.+shrinkAndFreezeMessages ::+     CSize -- Full size of each buffer+  -> CInt -- Expected sockaddr size+  -> Int -- Actual number of received messages+  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)+  -> Addr -- Array of mmsghdr+  -> IO (CInt,CUInt,UnliftedArray ByteArray)+shrinkAndFreezeMessages !bufSize !expSockAddrSize !n !bufs !mmsghdr0 = do+  r <- PM.unsafeNewUnliftedArray n+  go r 0 0 0 mmsghdr0+  where+  go !r !validation !ix !maxMsgSz !mmsghdr = if ix < n+    then do+      sz <- LST.peekMultipleMessageHeaderLength mmsghdr+      sockaddrSz <- LST.peekMultipleMessageHeaderNameLength mmsghdr+      buf <- PM.readUnliftedArray bufs ix+      when (cuintToInt sz < csizeToInt bufSize) (shrinkMutableByteArray buf (cuintToInt sz))+      PM.writeUnliftedArray r ix =<< PM.unsafeFreezeByteArray buf+      go r (validation .|. (sockaddrSz - expSockAddrSize)) (ix + 1) (max maxMsgSz sz)+        (PM.plusAddr mmsghdr (cintToInt LST.sizeofMultipleMessageHeader))+    else do+      a <- PM.unsafeFreezeUnliftedArray r+      pure (validation,maxMsgSz,a)++pokeMultipleMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> CUInt -> IO ()+pokeMultipleMessageHeader mmsgHdrAddr a b c d e f g len = do+  LST.pokeMultipleMessageHeaderName mmsgHdrAddr a+  LST.pokeMultipleMessageHeaderNameLength mmsgHdrAddr b+  LST.pokeMultipleMessageHeaderIOVector mmsgHdrAddr c+  LST.pokeMultipleMessageHeaderIOVectorLength mmsgHdrAddr d+  LST.pokeMultipleMessageHeaderControl mmsgHdrAddr e+  LST.pokeMultipleMessageHeaderControlLength mmsgHdrAddr f+  LST.pokeMultipleMessageHeaderFlags mmsgHdrAddr g+  LST.pokeMultipleMessageHeaderLength mmsgHdrAddr len++shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO ()+shrinkMutableByteArray (MutableByteArray arr) (I# sz) =+  PM.primitive_ (shrinkMutableByteArray# arr sz)++cintToInt :: CInt -> Int+cintToInt = fromIntegral++cuintToInt :: CUInt -> Int+cuintToInt = fromIntegral++csizeToInt :: CSize -> Int+csizeToInt = fromIntegral++cssizeToInt :: CSsize -> Int+cssizeToInt = fromIntegral++touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO ()+touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x++touchMutableByteArray :: MutableByteArray RealWorld -> IO ()+touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x++touchMutableUnliftedArray# :: MutableArrayArray# RealWorld -> IO ()+touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)++touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()+touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)

@@ -1,7 +1,21 @@+{-# language DataKinds #-} {-# language DerivingStrategies #-}+{-# language DuplicateRecordFields #-} {-# language GeneralizedNewtypeDeriving #-}+{-# language BinaryLiterals #-}+{-# language TypeApplications #-} +-- This is needed because hsc2hs does not currently handle ticked+-- promoted data constructors correctly.+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}++#define _GNU_SOURCE #include <sys/socket.h>+#include <netinet/in.h>+#include <netinet/ip.h>+#include <netinet/udp.h>+#include <asm/byteorder.h>+#include "custom.h"  -- | All of the data constructors provided by this module are unsafe. --   Only use them if you really know what you are doing.@@ -9,20 +23,87 @@   ( SocketFlags(..)   , dontWait   , truncate+  , controlTruncate   , closeOnExec   , nonblocking+  , headerInclude+    -- * Multiple Message Header+  , pokeMultipleMessageHeaderName+  , pokeMultipleMessageHeaderNameLength+  , pokeMultipleMessageHeaderIOVector+  , pokeMultipleMessageHeaderIOVectorLength+  , pokeMultipleMessageHeaderControl+  , pokeMultipleMessageHeaderControlLength+  , pokeMultipleMessageHeaderFlags+  , pokeMultipleMessageHeaderLength+  , peekMultipleMessageHeaderLength+  , peekMultipleMessageHeaderNameLength+  , sizeofMultipleMessageHeader+    -- * UDP Header+  , sizeofUdpHeader+  , pokeUdpHeaderSourcePort+  , pokeUdpHeaderDestinationPort+  , pokeUdpHeaderLength+  , pokeUdpHeaderChecksum+    -- * IPv4 Header+  , sizeofIpHeader+  , pokeIpHeaderVersionIhl+  , pokeIpHeaderTypeOfService+  , pokeIpHeaderTotalLength+  , pokeIpHeaderIdentifier+  , pokeIpHeaderFragmentOffset+  , pokeIpHeaderTimeToLive+  , pokeIpHeaderProtocol+  , pokeIpHeaderChecksum+  , pokeIpHeaderSourceAddress+  , pokeIpHeaderDestinationAddress   ) where  import Prelude hiding (truncate) -import Data.Bits (Bits((.|.)))-import Foreign.C.Types (CInt)-import Posix.Socket (MessageFlags(..))+import Data.Bits (Bits((.|.)),unsafeShiftL,unsafeShiftR)+import Data.Word (Word8,Word16,Word32)+import Data.Primitive (Addr(..),MutableByteArray,writeByteArray)+import Foreign.C.Types (CInt(..),CSize,CUInt)+import Posix.Socket (MessageFlags(..),Message(Receive),OptionName(..))+import Foreign.Storable (peekByteOff,pokeByteOff)+import GHC.Ptr (Ptr(..))+import GHC.Exts (RealWorld) +import qualified Data.Primitive as PM+ newtype SocketFlags = SocketFlags CInt   deriving stock (Eq)   deriving newtype (Bits) +-- newtype Collection :: Type -> Type where+--   Collection :: !(Ptr a) -> Collection a+-- +-- indexCollection :: Ptr a+--   => Collection a -> Int -> IO (Ptr a)+-- indexCollection (Collection p) n = advancePtr p n+-- data MessageHeader = MessageHeader+--   { name :: !Addr+--   , nameLength :: !CInt+--   , vector :: !(Ptr InputOutputVector)+--   , vectorLength :: !CSize+--   , control :: !(Ptr ControlMessageHeader)+--   , controlLength :: !CSize+--   , flags :: !(MessageFlags Receive)+--   }+-- +-- data IOVector = IOVector+--   { base :: !Addr+--   , length :: !CSize+--   }+-- +-- data ControlMessageHeader = ControlMessageHeader+--   { length :: !CInt+--   , level :: !CInt+--   , type_ :: !CInt+--   , data_ :: !Addr+--   }+ instance Semigroup SocketFlags where (<>) = (.|.) instance Monoid SocketFlags where mempty = SocketFlags 0 @@ -31,9 +112,13 @@ dontWait = MessageFlags #{const MSG_DONTWAIT}  -- | The @MSG_TRUNC@ receive flag.-truncate :: MessageFlags m+truncate :: MessageFlags Receive truncate = MessageFlags #{const MSG_DONTWAIT} +-- | The @MSG_CTRUNC@ receive flag.+controlTruncate :: MessageFlags Receive+controlTruncate = MessageFlags #{const MSG_CTRUNC}+ -- | The @SOCK_CLOEXEC@ receive flag or send flag. closeOnExec :: SocketFlags closeOnExec = SocketFlags #{const SOCK_CLOEXEC}@@ -42,3 +127,106 @@ nonblocking :: SocketFlags nonblocking = SocketFlags #{const SOCK_NONBLOCK} +-- | If enabled, the user supplies an IP header in front of the+-- user data.  Valid only for @SOCK_RAW@ sockets.+headerInclude :: OptionName+headerInclude = OptionName #{const IP_HDRINCL}++-- | The size of a @mmsghdr@ struct.+sizeofMultipleMessageHeader :: CInt+sizeofMultipleMessageHeader = #{size struct mmsghdr}++pokeMultipleMessageHeaderName :: Addr -> Addr -> IO ()+pokeMultipleMessageHeaderName (Addr p) (Addr x) = #{poke struct mmsghdr, msg_hdr.msg_name} (Ptr p) (Ptr x)++pokeMultipleMessageHeaderNameLength :: Addr -> CInt -> IO ()+pokeMultipleMessageHeaderNameLength (Addr p) = #{poke struct mmsghdr, msg_hdr.msg_namelen} (Ptr p)++pokeMultipleMessageHeaderIOVector :: Addr -> Addr -> IO ()+pokeMultipleMessageHeaderIOVector (Addr p) (Addr x) = #{poke struct mmsghdr, msg_hdr.msg_iov} (Ptr p) (Ptr x)++pokeMultipleMessageHeaderIOVectorLength :: Addr -> CSize -> IO ()+pokeMultipleMessageHeaderIOVectorLength (Addr p) = #{poke struct mmsghdr, msg_hdr.msg_iovlen} (Ptr p)++pokeMultipleMessageHeaderControl :: Addr -> Addr -> IO ()+pokeMultipleMessageHeaderControl (Addr p) (Addr x) = #{poke struct mmsghdr, msg_hdr.msg_control} (Ptr p) (Ptr x)++pokeMultipleMessageHeaderControlLength :: Addr -> CSize -> IO ()+pokeMultipleMessageHeaderControlLength (Addr p) = #{poke struct mmsghdr, msg_hdr.msg_controllen} (Ptr p)++pokeMultipleMessageHeaderFlags :: Addr -> MessageFlags Receive -> IO ()+pokeMultipleMessageHeaderFlags (Addr p) (MessageFlags i) = #{poke struct mmsghdr, msg_hdr.msg_flags} (Ptr p) i++pokeMultipleMessageHeaderLength :: Addr -> CUInt -> IO ()+pokeMultipleMessageHeaderLength (Addr p) i = #{poke struct mmsghdr, msg_len} (Ptr p) i++peekMultipleMessageHeaderNameLength :: Addr -> IO CInt+peekMultipleMessageHeaderNameLength (Addr p) = #{peek struct mmsghdr, msg_hdr.msg_namelen} (Ptr p)++peekMultipleMessageHeaderLength :: Addr -> IO CUInt+peekMultipleMessageHeaderLength (Addr p) = #{peek struct mmsghdr, msg_len} (Ptr p)++-- | The size of a @udphdr@ struct.+sizeofUdpHeader :: CInt+sizeofUdpHeader = #{size struct udphdr}++pokeUdpHeaderSourcePort :: Addr -> Word16 -> IO ()+pokeUdpHeaderSourcePort (Addr p) = #{poke struct udphdr, source} (Ptr p)++pokeUdpHeaderDestinationPort :: Addr -> Word16 -> IO ()+pokeUdpHeaderDestinationPort (Addr p) = #{poke struct udphdr, dest} (Ptr p)++pokeUdpHeaderLength :: Addr -> Word16 -> IO ()+pokeUdpHeaderLength (Addr p) = #{poke struct udphdr, len} (Ptr p)++pokeUdpHeaderChecksum :: Addr -> Word16 -> IO ()+pokeUdpHeaderChecksum (Addr p) = #{poke struct udphdr, check} (Ptr p)++-- | The size of an @iphdr@ struct.+sizeofIpHeader :: CInt+sizeofIpHeader = #{size struct iphdr}++-- | This poke function requires the user to pack the version and the+-- internet header length (IHL), each 4 bits, into a single 8-bit word.+-- The version should be in the most significant bits. This function+-- will marshal the value appropriately depending on the platform's+-- bit-endianness.+pokeIpHeaderVersionIhl :: Addr -> Word8 -> IO ()+-- TODO: Verify if this is correct.+#if defined(__LITTLE_ENDIAN_BITFIELD)+pokeIpHeaderVersionIhl p _ = PM.writeOffAddr p 0 (0b01000101 :: Word8)+  -- PM.writeOffAddr p 0 (unsafeShiftL w 4 .|. unsafeShiftR w 4)+  -- where+  -- rev = +#elif defined (__BIG_ENDIAN_BITFIELD)+pokeIpHeaderVersionIhl p w = PM.writeOffAddr p 0 w+#else+ERROR_BITFIELD_ENDIANNESS_NOT_SET+#endif++pokeIpHeaderTypeOfService :: Addr -> Word8 -> IO ()+pokeIpHeaderTypeOfService (Addr p) = #{poke struct iphdr, tos} (Ptr p)++pokeIpHeaderTotalLength :: Addr -> Word16 -> IO ()+pokeIpHeaderTotalLength (Addr p) = #{poke struct iphdr, tot_len} (Ptr p)++pokeIpHeaderIdentifier :: Addr -> Word16 -> IO ()+pokeIpHeaderIdentifier (Addr p) = #{poke struct iphdr, id} (Ptr p)++pokeIpHeaderFragmentOffset :: Addr -> Word16 -> IO ()+pokeIpHeaderFragmentOffset (Addr p) = #{poke struct iphdr, frag_off} (Ptr p)++pokeIpHeaderTimeToLive :: Addr -> Word8 -> IO ()+pokeIpHeaderTimeToLive (Addr p) = #{poke struct iphdr, ttl} (Ptr p)++pokeIpHeaderProtocol :: Addr -> Word8 -> IO ()+pokeIpHeaderProtocol (Addr p) = #{poke struct iphdr, protocol} (Ptr p)++pokeIpHeaderChecksum :: Addr -> Word16 -> IO ()+pokeIpHeaderChecksum (Addr p) = #{poke struct iphdr, check} (Ptr p)++pokeIpHeaderSourceAddress :: Addr -> Word32 -> IO ()+pokeIpHeaderSourceAddress (Addr p) = #{poke struct iphdr, saddr} (Ptr p)++pokeIpHeaderDestinationAddress :: Addr -> Word32 -> IO ()+pokeIpHeaderDestinationAddress (Addr p) = #{poke struct iphdr, daddr} (Ptr p)

@@ -13,7 +13,7 @@ --     that \"Any sane library must have @socklen_t@ be the same size as @int@. --     Anything else breaks any BSD socket layer stuff.\" --   * Send and receive each have several variants. They are distinguished by---     the safe/unsafe FFI use and by the @Addr@/@ByteArray@/@MutableByteArray@+--     the safe\/unsafe FFI use and by the @Addr@\/@ByteArray@/@MutableByteArray@ --     buffer type. They all call @send@ or @recv@ exactly once. They do not --     repeatedly make syscalls like some of the functions in @network@. --     Users who want that behavior need to build on top of this package.@@ -42,6 +42,8 @@   , uninterruptibleGetSocketName     -- ** Get Socket Option   , uninterruptibleGetSocketOption+    -- ** Set Socket Option+  , uninterruptibleSetSocketOptionInt     -- ** Close   , close   , uninterruptibleClose@@ -58,6 +60,8 @@     -- ** Send To   , uninterruptibleSendToByteArray   , uninterruptibleSendToMutableByteArray+    -- ** Write Vector+  , writeVector     -- ** Receive   , receive   , receiveByteArray@@ -66,6 +70,10 @@     -- ** Receive From   , uninterruptibleReceiveFromMutableByteArray   , uninterruptibleReceiveFromMutableByteArray_+    -- ** Receive Message+    -- $receiveMessage+  , uninterruptibleReceiveMessageA+  , uninterruptibleReceiveMessageB     -- ** Byte-Order Conversion     -- $conversion   , hostToNetworkLong@@ -79,6 +87,7 @@   , OptionName(..)   , OptionValue(..)   , Level(..)+  , Message(..)   , MessageFlags(..)   , ShutdownType(..)     -- * Socket Address@@ -91,6 +100,7 @@   , PSP.encodeSocketAddressUnix     -- ** Decoding   , PSP.decodeSocketAddressInternet+  , PSP.indexSocketAddressInternet     -- ** Sizes   , PSP.sizeofSocketAddressInternet     -- * Data Construction@@ -116,6 +126,8 @@   , PST.peek   , PST.outOfBand   , PST.waitAll+    -- ** Send Flags+  , PST.noSignal     -- ** Shutdown Types   , PST.read   , PST.write@@ -124,18 +136,46 @@   , PST.levelSocket     -- ** Option Names   , PST.optionError+  , PST.broadcast+    -- ** Message Header+    -- *** Peek+  , PST.peekMessageHeaderName+  , PST.peekMessageHeaderNameLength+  , PST.peekMessageHeaderIOVector+  , PST.peekMessageHeaderIOVectorLength+    -- *** Poke+  , PST.pokeMessageHeaderName+  , PST.pokeMessageHeaderNameLength+  , PST.pokeMessageHeaderIOVector+  , PST.pokeMessageHeaderIOVectorLength+  , PST.pokeMessageHeaderControl+  , PST.pokeMessageHeaderControlLength+  , PST.pokeMessageHeaderFlags+    -- *** Metadata+  , PST.sizeofMessageHeader+    -- ** IO Vector+    -- *** Peek+  , PST.peekIOVectorBase+  , PST.peekIOVectorLength+    -- *** Poke+  , PST.pokeIOVectorBase+  , PST.pokeIOVectorLength+    -- *** Metadata+  , PST.sizeofIOVector   ) where  import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.IO (IO(..)) import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),Addr(..),ByteArray(..))+import Data.Primitive (MutableUnliftedArray(..),UnliftedArray(..)) import Data.Word (Word16,Word32,byteSwap16,byteSwap32) import Data.Void (Void) import Foreign.C.Error (Errno,getErrno) import Foreign.C.Types (CInt(..),CSize(..)) import Foreign.Ptr (nullPtr)-import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#,Addr#,Int(I#))-import GHC.Exts (shrinkMutableByteArray#)+import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#,Addr#)+import GHC.Exts (ArrayArray#,MutableArrayArray#,Int(I#))+import GHC.Exts (shrinkMutableByteArray#,touch#) import Posix.Socket.Types (Domain(..),Protocol(..),Type(..),SocketAddress(..)) import Posix.Socket.Types (MessageFlags(..),Message(..),ShutdownType(..)) import Posix.Socket.Types (Level(..),OptionName(..),OptionValue(..))@@ -213,6 +253,13 @@                       -> MutableByteArray# RealWorld -- Option len (Ptr CInt)                       -> IO CInt +foreign import ccall unsafe "sys/socket.h setsockopt_int"+  c_unsafe_setsockopt_int :: Fd+                          -> Level+                          -> OptionName+                          -> CInt -- option_value+                          -> IO CInt+ -- Per the spec the type signature of connect is: --   int connect(int sockfd, const struct sockaddr *addr, socklen_t addrlen); -- The bytearray argument is actually SocketAddress.@@ -252,6 +299,9 @@ foreign import ccall unsafe "sys/socket.h sendto_offset"   c_unsafe_mutable_bytearray_sendto :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize +foreign import ccall safe "sys/uio.h writev"+  c_safe_writev :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CSsize+ -- There are several ways to wrap recv. foreign import ccall safe "sys/socket.h recv"   c_safe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize@@ -266,6 +316,12 @@ foreign import ccall unsafe "sys/socket.h recvfrom_offset"   c_unsafe_mutable_byte_array_ptr_recvfrom :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags 'Receive -> Ptr Void -> Ptr CInt -> IO CSsize +foreign import ccall unsafe "sys/socket.h recvmsg"+  c_unsafe_addr_recvmsg :: Fd+                        -> Addr# -- This addr is a pointer to msghdr+                        -> MessageFlags 'Receive+                        -> IO CSsize+ -- | Create an endpoint for communication, returning a file --   descriptor that refers to that endpoint. The --   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/socket.html POSIX specification>@@ -480,6 +536,22 @@       pure (Right (sz,OptionValue value))     else fmap Left getErrno +-- | Set the value for the option specified by the 'Option' argument for+--   the socket specified by the 'Fd' argument. The+--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>+--   of @getsockopt@ includes more details. This variant requires that the+--   size of the @option_value@+--   be the same as the size of 'CInt'. That is, the @option_name@ must+--   describe an option that is represented by a C integer. This is a+--   common case, so we avoid allocations by reference-passing in C.+uninterruptibleSetSocketOptionInt ::+     Fd -- ^ Socket+  -> Level -- ^ Socket level+  -> OptionName -- ^ Option name+  -> CInt -- ^ Option value+  -> IO (Either Errno ())+uninterruptibleSetSocketOptionInt sock level optName optValue =+  c_unsafe_setsockopt_int sock level optName optValue >>= errorsFromInt  -- | Send data from a byte array over a network socket. Users --   may specify an offset and a length to send fewer bytes than are@@ -500,6 +572,58 @@     PM.copyByteArray x (cintToInt off) b 0 (csizeToInt len)     errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags +-- | Write data from multiple byte arrays to the file/socket associated+--   with the file descriptor. This does not support slicing.+writeVector ::+     Fd -- ^ Socket+  -> UnliftedArray ByteArray -- ^ Source byte arrays+  -> IO (Either Errno CSize)+writeVector fd buffers = do+  iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <-+    PM.newPinnedByteArray+      (cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)++  downward (PM.sizeofUnliftedArray buffers) $ \i -> do+    buffer <- pinByteArray (PM.indexUnliftedArray buffers i)++    let+      targetAddr :: Addr+      targetAddr =+        PM.mutableByteArrayContents iovecs `PM.plusAddr`+          (i * cintToInt PST.sizeofIOVector)++    PST.pokeIOVectorBase targetAddr (PM.byteArrayContents buffer)+    PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))++  r <- errorsFromSize =<<+    c_safe_writev fd iovecs# (intToCInt (PM.sizeofUnliftedArray buffers))+  -- Touching the unlifted array here is crucial to ensuring that+  -- the buffers do not get GCed before c_safe_writev. Just touching+  -- the unlifted array should keep all of its children alive too.+  touchUnliftedArray buffers+  pure r++-- Internal function. Upper bound is exclusive. Hits every+-- int in the range [0,hi) from highest to lowest.+downward :: Int -> (Int -> IO a) -> IO ()+downward !hi f = go (hi - 1) where+  go !ix = if ix >= 0+    then f ix *> go (ix - 1)+    else pure ()++-- | Copy and pin a byte array if, it's not already pinned.+pinByteArray :: ByteArray -> IO ByteArray+pinByteArray byteArray =+  if PM.isByteArrayPinned byteArray+    then+      pure byteArray+    else do+      pinnedByteArray <- PM.newPinnedByteArray len+      PM.copyByteArray pinnedByteArray 0 byteArray 0 len+      PM.unsafeFreezeByteArray pinnedByteArray+  where+    len = PM.sizeofByteArray byteArray+ -- | Send data from a mutable byte array over a network socket. Users --   may specify an offset and a length to send fewer bytes than are --   actually present in the array. Since this uses the safe@@ -578,7 +702,7 @@ --   apply to this function as well. The offset and length arguments --   cause a slice of the byte array to be sent rather than the entire --   byte array.-uninterruptibleSendToByteArray :: +uninterruptibleSendToByteArray ::      Fd -- ^ Socket   -> ByteArray -- ^ Source byte array   -> CInt -- ^ Offset into source array@@ -594,7 +718,7 @@ --   apply to this function as well. The offset and length arguments --   cause a slice of the mutable byte array to be sent rather than the entire --   byte array.-uninterruptibleSendToMutableByteArray :: +uninterruptibleSendToMutableByteArray ::      Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Source byte array   -> CInt -- ^ Offset into source array@@ -713,6 +837,83 @@ uninterruptibleReceiveFromMutableByteArray_ !fd (MutableByteArray !b) !off !len !flags =   c_unsafe_mutable_byte_array_ptr_recvfrom fd b off len flags nullPtr nullPtr >>= errorsFromSize +++-- | Receive a message, scattering the input. This does not provide+--   the socket address or the control messages. All of the chunks+--   must have the same maximum size. All resulting byte arrays have+--   been explicitly pinned.+uninterruptibleReceiveMessageA ::+     Fd -- ^ Socket+  -> CSize -- ^ Maximum bytes per chunk+  -> CSize -- ^ Maximum number of chunks+  -> MessageFlags 'Receive -- ^ Flags+  -> IO (Either Errno (CSize,UnliftedArray ByteArray))+uninterruptibleReceiveMessageA !s !chunkSize !chunkCount !flags = do+  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)+  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)+  let iovecsAddr = PM.mutableByteArrayContents iovecsBuf+  initializeIOVectors bufs iovecsAddr chunkSize chunkCount+  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)+  let !msgHdrAddr@(Addr msgHdrAddr#) = PM.mutableByteArrayContents msgHdrBuf+  pokeMessageHeader msgHdrAddr PM.nullAddr 0 iovecsAddr chunkCount PM.nullAddr 0 flags+  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags+  if r > (-1)+    then do+      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs+      frozenBufs <- deepFreezeIOVectors filled bufs+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      pure (Right (cssizeToCSize r,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      fmap Left getErrno++-- | Receive a message, scattering the input. This provides the socket+--   address but does not include control messages. All of the chunks+--   must have the same maximum size. All resulting byte arrays have+--   been explicitly pinned.+uninterruptibleReceiveMessageB ::+     Fd -- ^ Socket+  -> CSize -- ^ Maximum bytes per chunk+  -> CSize -- ^ Maximum number of chunks+  -> MessageFlags 'Receive -- ^ Flags+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (CInt,SocketAddress,CSize,UnliftedArray ByteArray))+uninterruptibleReceiveMessageB !s !chunkSize !chunkCount !flags !maxSockAddrSz = do+  sockAddrBuf <- PM.newPinnedByteArray (cintToInt maxSockAddrSz)+  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)+  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)+  let iovecsAddr = PM.mutableByteArrayContents iovecsBuf+  initializeIOVectors bufs iovecsAddr chunkSize chunkCount+  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)+  let !msgHdrAddr@(Addr msgHdrAddr#) = PM.mutableByteArrayContents msgHdrBuf+  pokeMessageHeader msgHdrAddr (PM.mutableByteArrayContents sockAddrBuf) maxSockAddrSz iovecsAddr chunkCount PM.nullAddr 0 flags+  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags+  if r > (-1)+    then do+      actualSockAddrSz <- PST.peekMessageHeaderNameLength msgHdrAddr+      if actualSockAddrSz < maxSockAddrSz+        then shrinkMutableByteArray sockAddrBuf (cintToInt actualSockAddrSz)+        else pure ()+      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf+      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs+      frozenBufs <- deepFreezeIOVectors filled bufs+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      touchMutableByteArray sockAddrBuf+      pure (Right (actualSockAddrSz,SocketAddress sockAddr,cssizeToCSize r,frozenBufs))+    else do+      touchMutableUnliftedArray bufs+      touchMutableByteArray iovecsBuf+      touchMutableByteArray msgHdrBuf+      touchMutableByteArray sockAddrBuf+      fmap Left getErrno+ -- | Close a socket. The <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification> --   includes more details. This uses the safe FFI. close ::@@ -774,6 +975,9 @@ intToCInt :: Int -> CInt intToCInt = fromIntegral +intToCSize :: Int -> CSize+intToCSize = fromIntegral+ cintToInt :: CInt -> Int cintToInt = fromIntegral @@ -787,12 +991,6 @@ cssizeToCSize :: CSsize -> CSize cssizeToCSize = fromIntegral --- touchByteArray :: ByteArray -> IO ()--- touchByteArray (ByteArray x) = touchByteArray# x--- --- touchByteArray# :: ByteArray# -> IO ()--- touchByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)- shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO () shrinkMutableByteArray (MutableByteArray arr) (I# sz) =   PM.primitive_ (shrinkMutableByteArray# arr sz)@@ -821,11 +1019,130 @@   BigEndian -> id   LittleEndian -> byteSwap32 +pokeMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> IO ()+pokeMessageHeader msgHdrAddr a b c d e f g = do+  PST.pokeMessageHeaderName msgHdrAddr a+  PST.pokeMessageHeaderNameLength msgHdrAddr b+  PST.pokeMessageHeaderIOVector msgHdrAddr c+  PST.pokeMessageHeaderIOVectorLength msgHdrAddr d+  PST.pokeMessageHeaderControl msgHdrAddr e+  PST.pokeMessageHeaderControlLength msgHdrAddr f+  PST.pokeMessageHeaderFlags msgHdrAddr g++-- This sets up an array of iovec. The iov_len is assigned to the+-- same length in all of these. The actual buffers are allocated+-- and stuck in an unlifted array. Pointers to these buffers (we can+-- do that because they are pinned) go in the iov_base field.+initializeIOVectors ::+     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers+  -> Addr -- array of iovec+  -> CSize -- chunk size+  -> CSize -- chunk count+  -> IO ()+initializeIOVectors bufs iovecsAddr chunkSize chunkCount =+  let go !ix !iovecAddr = if ix < csizeToInt chunkCount+        then do+          initializeIOVector bufs iovecAddr chunkSize ix+          go (ix + 1) (PM.plusAddr iovecAddr (cintToInt PST.sizeofIOVector))+        else pure ()+   in go 0 iovecsAddr++-- Initialize a single iovec. We write the pinned byte array into+-- both the iov_base field and into an unlifted array. There is a+-- copy of this function in Linux.Socket.+initializeIOVector ::+     MutableUnliftedArray RealWorld (MutableByteArray RealWorld)+  -> Addr+  -> CSize+  -> Int+  -> IO ()+initializeIOVector bufs iovecAddr chunkSize ix = do+  buf <- PM.newPinnedByteArray (csizeToInt chunkSize)+  PM.writeUnliftedArray bufs ix buf+  PST.pokeIOVectorBase iovecAddr (PM.mutableByteArrayContents buf)+  PST.pokeIOVectorLength iovecAddr chunkSize++-- This is intended to be called on an array of iovec after recvmsg+-- and before deepFreezeIOVectors. An adaptation of this function exists+-- in Linux.Socket.+countAndShrinkIOVectors ::+     Int -- Total number of supplied iovecs+  -> Int -- Total amount of space used by receive+  -> Int -- Amount of space per buffer (each buffer must have equal size)+  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)+  -> IO Int+countAndShrinkIOVectors !n !totalUsedSz !maxBufSz !bufs = go 0 totalUsedSz where+  -- This outer if (checking that the index is in bounds) should+  -- not actually be necessary. I will remove once the test suite+  -- bolsters my confidence.+  go !ix !remainingBytes = if ix < n+    then if remainingBytes >= maxBufSz+      then go+        (ix + 1)+        (remainingBytes - maxBufSz)+      else if remainingBytes == 0+        then pure ix+        else do+          buf <- PM.readUnliftedArray bufs ix+          shrinkMutableByteArray buf remainingBytes+          pure (ix + 1)+    else pure ix++-- Freeze a slice of the mutable byte arrays inside the unlifted+-- array. This copies makes a copy of the slice of the original+-- array. A copy of this function exists in Linux.Socket.+deepFreezeIOVectors ::+     Int -- How many iovecs actually had a non-zero number of bytes+  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)+  -> IO (UnliftedArray ByteArray)+deepFreezeIOVectors n m = do+  x <- PM.unsafeNewUnliftedArray n+  let go !ix = if ix < n+        then do+          PM.writeUnliftedArray x ix =<< PM.unsafeFreezeByteArray =<< PM.readUnliftedArray m ix+          go (ix + 1)+        else PM.unsafeFreezeUnliftedArray x+  go 0++touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO ()+touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x++touchUnliftedArray :: UnliftedArray a -> IO ()+touchUnliftedArray (UnliftedArray x) = touchUnliftedArray# x++touchMutableByteArray :: MutableByteArray RealWorld -> IO ()+touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x++touchMutableUnliftedArray# :: MutableArrayArray# RealWorld -> IO ()+touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)++touchUnliftedArray# :: ArrayArray# -> IO ()+touchUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)++touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()+touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)+ {- $conversion These functions are used to convert IPv4 addresses and ports between network byte order and host byte order. They are essential when working with 'SocketAddressInternet'. To avoid getting in the way of GHC compile-time optimizations, these functions are not actually implemented with FFI calls to @htonl@ and friends. Rather, they are reimplemented in haskell.+-}+++{- $receiveMessage+The function @recvMsg@ presents us with a challenge. Since it uses a+data structure with many nested pointers, we have to use pinned byte+arrays for everything. There is also the difficulty of marshalling+haskell's unlifted array (array of arrays) type into what C's+array of @iovec@. There's the question of the array of @cmsghdr@s.+On top of all of this, we have to answer the question of whether+we want to accept mutable buffer or whether we want to do the+allocations internally (both for the buffers and for the ancilliary+data structurs needed to massage the data into what C expects).++What we do to handle this in offer several variants of @recvmsg@+ending in @A@, @B@, etc. -} 

@@ -50,6 +50,8 @@   , peek   , outOfBand   , waitAll+    -- * Send Flags+  , noSignal     -- * Shutdown Types   , read   , write@@ -58,14 +60,48 @@   , levelSocket     -- * Option Names   , optionError+  , broadcast+    -- * Message Header+    -- ** Peek+  , peekMessageHeaderName+  , peekMessageHeaderNameLength+  , peekMessageHeaderIOVector+  , peekMessageHeaderIOVectorLength+  , peekMessageHeaderControl+  , peekMessageHeaderControlLength+  , peekMessageHeaderFlags+  , peekControlMessageHeaderLevel+  , peekControlMessageHeaderLength+  , peekControlMessageHeaderType+    -- ** Poke+  , pokeMessageHeaderName+  , pokeMessageHeaderNameLength+  , pokeMessageHeaderIOVector+  , pokeMessageHeaderIOVectorLength+  , pokeMessageHeaderControl+  , pokeMessageHeaderControlLength+  , pokeMessageHeaderFlags+    -- ** Metadata+  , sizeofMessageHeader+    -- * IO Vector+    -- ** Peek+  , peekIOVectorBase+  , peekIOVectorLength+    -- ** Poke+  , pokeIOVectorBase+  , pokeIOVectorLength+    -- ** Metadata+  , sizeofIOVector   ) where  import Prelude hiding (read)  import Data.Bits (Bits,(.|.))-import Data.Primitive (ByteArray)+import Data.Primitive (ByteArray,Addr(..)) import Data.Word (Word16,Word32,Word64)-import Foreign.C.Types (CInt(..))+import Foreign.C.Types (CInt(..),CSize)+import Foreign.Storable (peekByteOff,pokeByteOff)+import GHC.Ptr (Ptr(..))  import qualified Data.Kind @@ -78,10 +114,12 @@ --   basis. newtype Type = Type CInt -newtype Protocol = Protocol CInt+newtype Protocol = Protocol { getProtocol :: CInt }  newtype Level = Level CInt +-- | Options used in the @option_name@ argument in @getsockopt@+--   or @setsockopt@.   newtype OptionName = OptionName CInt  -- | Which end of the socket to shutdown.@@ -105,8 +143,10 @@  -- | The @sockaddr@ data. This is an extensible tagged union, so this library --   has chosen to represent it as byte array. It is up to platform-specific---   libraries to inhabit this type with values.+--   libraries to inhabit this type with values. The byte array backing this+--   may be unpinned or pinned. newtype SocketAddress = SocketAddress ByteArray+  deriving newtype (Eq,Show)  -- | The @option_value@ data. newtype OptionValue = OptionValue ByteArray@@ -209,6 +249,10 @@ waitAll :: MessageFlags Receive waitAll = MessageFlags #{const MSG_WAITALL} +-- | The @MSG_NOSIGNAL@ send flag.+noSignal :: MessageFlags Send+noSignal = MessageFlags #{const MSG_NOSIGNAL}+ -- | The default protocol for a socket type. defaultProtocol :: Protocol defaultProtocol = Protocol 0@@ -256,4 +300,98 @@ -- | Socket error status (e.g. @SO_ERROR@) optionError :: OptionName optionError = OptionName #{const SO_ERROR}++-- | Transmission of broadcast messages is supported (e.g. @SO_BROADCAST@)+broadcast :: OptionName+broadcast = OptionName #{const SO_BROADCAST}++peekControlMessageHeaderLength :: Addr -> IO CInt+peekControlMessageHeaderLength (Addr p) = #{peek struct cmsghdr, cmsg_len} (Ptr p)++peekControlMessageHeaderLevel :: Addr -> IO Level+peekControlMessageHeaderLevel (Addr p) = do+  i <- #{peek struct cmsghdr, cmsg_level} (Ptr p)+  pure (Level i)++peekControlMessageHeaderType :: Addr -> IO Type+peekControlMessageHeaderType (Addr p) = do+  i <- #{peek struct cmsghdr, cmsg_type} (Ptr p)+  pure (Type i)++-- Think about reintroducing this function when it becomes necessary.+-- advanceControlMessageHeaderData :: Addr -> Addr+-- advanceControlMessageHeaderData p =+--   PM.plusAddr p (#{size struct cmsghdr})++peekIOVectorBase :: Addr -> IO Addr+peekIOVectorBase (Addr p) = do+  Ptr x <- #{peek struct iovec, iov_base} (Ptr p)+  pure (Addr x)++peekIOVectorLength :: Addr -> IO CSize+peekIOVectorLength (Addr p) = #{peek struct iovec, iov_len} (Ptr p)++-- | The size of a serialized @msghdr@.+sizeofMessageHeader :: CInt+sizeofMessageHeader = #{size struct msghdr}++-- | The size of a serialized @iovec@.+sizeofIOVector :: CInt+sizeofIOVector = #{size struct iovec}++peekMessageHeaderName :: Addr -> IO Addr+peekMessageHeaderName (Addr p) = do+  Ptr x <- #{peek struct msghdr, msg_name} (Ptr p)+  pure (Addr x)++pokeMessageHeaderName :: Addr -> Addr -> IO ()+pokeMessageHeaderName (Addr p) (Addr x) = #{poke struct msghdr, msg_name} (Ptr p) (Ptr x)++pokeMessageHeaderNameLength :: Addr -> CInt -> IO ()+pokeMessageHeaderNameLength (Addr p) = #{poke struct msghdr, msg_namelen} (Ptr p)++pokeMessageHeaderIOVector :: Addr -> Addr -> IO ()+pokeMessageHeaderIOVector (Addr p) (Addr x) = #{poke struct msghdr, msg_iov} (Ptr p) (Ptr x)++pokeMessageHeaderIOVectorLength :: Addr -> CSize -> IO ()+pokeMessageHeaderIOVectorLength (Addr p) = #{poke struct msghdr, msg_iovlen} (Ptr p)++pokeMessageHeaderControl :: Addr -> Addr -> IO ()+pokeMessageHeaderControl (Addr p) (Addr x) = #{poke struct msghdr, msg_control} (Ptr p) (Ptr x)++pokeMessageHeaderControlLength :: Addr -> CSize -> IO ()+pokeMessageHeaderControlLength (Addr p) = #{poke struct msghdr, msg_controllen} (Ptr p)++pokeMessageHeaderFlags :: Addr -> MessageFlags Receive -> IO ()+pokeMessageHeaderFlags (Addr p) (MessageFlags i) = #{poke struct msghdr, msg_flags} (Ptr p) i++peekMessageHeaderNameLength :: Addr -> IO CInt+peekMessageHeaderNameLength (Addr p) = #{peek struct msghdr, msg_namelen} (Ptr p)++peekMessageHeaderIOVector :: Addr -> IO Addr+peekMessageHeaderIOVector (Addr p) = do+  Ptr r <- #{peek struct msghdr, msg_iov} (Ptr p)+  pure (Addr r)++peekMessageHeaderIOVectorLength :: Addr -> IO CSize+peekMessageHeaderIOVectorLength (Addr p) = #{peek struct msghdr, msg_iovlen} (Ptr p)++peekMessageHeaderControl :: Addr -> IO Addr+peekMessageHeaderControl (Addr p) = do+  Ptr r <- #{peek struct msghdr, msg_control} (Ptr p)+  pure (Addr r)++pokeIOVectorBase :: Addr -> Addr -> IO ()+pokeIOVectorBase (Addr p) (Addr x) = #{poke struct iovec, iov_base} (Ptr p) (Ptr x)++pokeIOVectorLength :: Addr -> CSize -> IO ()+pokeIOVectorLength (Addr p) = #{poke struct iovec, iov_len} (Ptr p)++peekMessageHeaderControlLength :: Addr -> IO CSize+peekMessageHeaderControlLength (Addr p) = #{peek struct msghdr, msg_controllen} (Ptr p)++peekMessageHeaderFlags :: Addr -> IO (MessageFlags Receive)+peekMessageHeaderFlags (Addr p) = do+  i <- #{peek struct msghdr, msg_flags} (Ptr p)+  pure (MessageFlags i) 

@@ -1,36 +1,50 @@ {-# language BangPatterns #-}+{-# language NamedFieldPuns #-} {-# language ScopedTypeVariables #-} -import Test.Tasty-import Test.Tasty.HUnit-import Foreign.C.Error (Errno,errnoToIOError)-import Data.Primitive (ByteArray) import Control.Concurrent (forkIO)+import Control.Concurrent (threadWaitRead,threadWaitWrite) import Control.Monad (when)+import Data.Primitive (ByteArray)+import Data.Word (Word32,Word8)+import Foreign.C.Error (Errno,errnoToIOError) import Foreign.C.Types (CInt,CSize)-import Control.Concurrent (threadWaitRead)+import Test.Tasty+import Test.Tasty.HUnit  import qualified GHC.Exts as E import qualified Data.Primitive as PM import qualified Data.Primitive.MVar as PM import qualified Posix.Socket as S+import qualified Linux.Socket as L  main :: IO () main = defaultMain tests  tests :: TestTree-tests = testGroup "Tests"-  [ testGroup "sockets"-    [ testCase "A" testSocketsA-    , testCase "B" testSocketsB-    , testCase "C" testSocketsC-    , testCase "D" testSocketsD+tests = testGroup "tests"+  [ testGroup "posix"+    [ testGroup "sockets"+      [ testCase "A" testSocketsA+      , testCase "B" testSocketsB+      , testCase "C" testSocketsC+      , testCase "D" testSocketsD+      , testCase "E" testSocketsE+      , testCase "F" testSocketsF+      , testCase "G" testSocketsG+      ]     ]+  , testGroup "linux"+    [ testGroup "sockets"+      [ testCase "A" testLinuxSocketsA+      , testCase "B" testLinuxSocketsB+      ]+    ]   ]  testSocketsA :: Assertion testSocketsA = do-  (a,b) <- demand =<< S.socketPair S.unix S.datagram S.defaultProtocol+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol   m <- PM.newEmptyMVar   _ <- forkIO $ S.receiveByteArray b 5 mempty >>= PM.putMVar m   bytesSent <- demand =<< S.sendByteArray a sample 0 5 mempty@@ -43,7 +57,7 @@   let limit = 10       wordSz = PM.sizeOf (undefined :: Int)       cwordSz = fromIntegral wordSz :: CSize-  (a,b) <- demand =<< S.socketPair S.unix S.datagram S.defaultProtocol+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol   lock <- PM.newEmptyMVar   let go1 !(ix :: Int) !(n :: Int) = if (ix < limit)         then do@@ -70,7 +84,7 @@  testSocketsC :: Assertion testSocketsC = do-  (a,b) <- demand =<< S.socketPair S.unix S.datagram S.defaultProtocol+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol   m <- PM.newEmptyMVar   _ <- forkIO $ S.receiveByteArray a 5 mempty >>= PM.putMVar m   bytesSent <- demand =<< S.sendByteArray b sample 0 5 mempty@@ -80,19 +94,106 @@  testSocketsD :: Assertion testSocketsD = do-  (a,b) <- demand =<< S.socketPair S.unix S.datagram S.defaultProtocol+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol   _ <- forkIO $ do     bytesSent <- demand =<< S.sendByteArray b sample 0 5 mempty     when (bytesSent /= 5) (fail "testSocketsD: bytesSent was wrong")   actual <- demand =<< S.receiveByteArray a 5 mempty   sample @=? actual +testSocketsE :: Assertion+testSocketsE = do+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol+  _ <- forkIO $ do+    threadWaitWrite b+    bytesSent <- demand =<< S.uninterruptibleSendByteArray b sample 0 5 mempty+    when (bytesSent /= 5) (fail "testSocketsE: bytesSent was wrong")+  threadWaitRead a+  actual <- demand =<< S.uninterruptibleReceiveMessageA a 3 10 mempty+  (5,E.fromList [E.fromList [1,2,3],E.fromList [4,5]]) @=? actual++testSocketsF :: Assertion+testSocketsF = do+  a <- demand =<< S.uninterruptibleSocket S.internet S.datagram S.defaultProtocol+  demand =<< S.uninterruptibleBind a (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))+  (expectedSzA,expectedSockAddrA) <- demand =<< S.uninterruptibleGetSocketName a 128+  when (expectedSzA > 128) (fail "testSocketsF: bad socket address size for socket A")+  portA <- case S.decodeSocketAddressInternet expectedSockAddrA of+    Nothing -> fail "testSocketsF: not a sockaddr_in"+    Just (S.SocketAddressInternet {S.port}) -> pure port+  b <- demand =<< S.uninterruptibleSocket S.internet S.datagram S.defaultProtocol+  demand =<< S.uninterruptibleBind b (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))+  threadWaitWrite b+  bytesSent <- demand =<< S.uninterruptibleSendToByteArray b sample 0 5 mempty (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))+  when (bytesSent /= 5) (fail "testSocketsF: bytesSent was wrong")+  threadWaitRead a+  actual <- demand =<< S.uninterruptibleReceiveMessageB a 5 2 mempty 128+  (expectedSzB,expectedSockAddrB) <- demand =<< S.uninterruptibleGetSocketName b 128+  when (expectedSzB > 128) (fail "testSocketsF: bad socket address size for socket B")+  (expectedSzB,expectedSockAddrB,5,E.fromList [sample]) @=? actual++testSocketsG :: Assertion+testSocketsG = do+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol+  _ <- forkIO $ do+    bytesSent <- demand =<< S.writeVector b+      ( E.fromList+        [ E.fromList (enumFromTo (1 :: Word8) 6)+        , E.fromList (enumFromTo (7 :: Word8) 9)+        ]+      )+    when (bytesSent /= 9) (fail "testSocketsG: bytesSent was wrong")+  actual <- demand =<< S.receiveByteArray a 9 mempty+  E.fromList (enumFromTo (1 :: Word8) 9) @=? actual++testLinuxSocketsA :: Assertion+testLinuxSocketsA = do+  (a,b) <- demand =<< S.uninterruptibleSocketPair S.unix S.datagram S.defaultProtocol+  threadWaitWrite b+  bytesSent1 <- demand =<< S.uninterruptibleSendByteArray b sample 0 5 mempty+  threadWaitWrite b+  bytesSent2 <- demand =<< S.uninterruptibleSendByteArray b sample2 0 4 mempty+  when (bytesSent1 /= 5) (fail "testLinuxSocketsA: bytesSent1 was wrong")+  when (bytesSent2 /= 4) (fail "testLinuxSocketsA: bytesSent2 was wrong")+  threadWaitRead a+  actual <- demand =<< L.uninterruptibleReceiveMultipleMessageA a 6 3 L.dontWait+  (5,E.fromList [sample,sample2]) @=? actual++testLinuxSocketsB :: Assertion+testLinuxSocketsB = do+  a <- demand =<< S.uninterruptibleSocket S.internet S.datagram S.defaultProtocol+  demand =<< S.uninterruptibleBind a (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))+  (expectedSzA,expectedSockAddrA) <- demand =<< S.uninterruptibleGetSocketName a 128+  when (expectedSzA /= S.sizeofSocketAddressInternet) (fail "testLinixSocketsB: bad socket address size for socket A")+  portA <- case S.decodeSocketAddressInternet expectedSockAddrA of+    Nothing -> fail "testLinixSocketsB: not a sockaddr_in"+    Just (S.SocketAddressInternet {S.port}) -> pure port+  b <- demand =<< S.uninterruptibleSocket S.internet S.datagram S.defaultProtocol+  demand =<< S.uninterruptibleBind b (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))+  threadWaitWrite b+  bytesSent1 <- demand =<< S.uninterruptibleSendToByteArray b sample 0 5 mempty (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))+  when (bytesSent1 /= 5) (fail "testLinixSocketsB: bytesSent1 was wrong")+  threadWaitWrite b+  bytesSent2 <- demand =<< S.uninterruptibleSendToByteArray b sample2 0 4 mempty (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))+  when (bytesSent2 /= 4) (fail "testLinixSocketsB: bytesSent2 was wrong")+  threadWaitRead a+  actual <- demand =<< L.uninterruptibleReceiveMultipleMessageB a S.sizeofSocketAddressInternet 6 3 L.dontWait+  (expectedSzB,S.SocketAddress sabytesB) <- demand =<< S.uninterruptibleGetSocketName b 128+  when (expectedSzB /= S.sizeofSocketAddressInternet) (fail "testLinixSocketsB: bad socket address size for socket B")+  (0,sabytesB <> sabytesB,5,E.fromList [sample,sample2]) @=? actual+ sample :: ByteArray sample = E.fromList [1,2,3,4,5] +sample2 :: ByteArray+sample2 = E.fromList [6,7,8,9]+ demand :: Either Errno a -> IO a demand = either (\e -> ioError (errnoToIOError "test" e Nothing Nothing)) pure    oneWord :: CSize -> IO () oneWord x = if x == fromIntegral (PM.sizeOf (undefined :: Int)) then pure () else fail "expected one machine word"++localhost :: Word32+localhost = S.hostToNetworkLong 2130706433