posix-api (empty) → 0.1.0.0

raw patch · 13 files changed

+1268/−0 lines, 13 filesdep +basedep +posix-apidep +primitivesetup-changed

Dependencies added: base, posix-api, primitive, tasty, tasty-hunit

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• Setup.hs +2/−0
• cbits/HaskellPosix.c +21/−0
• include/HaskellPosix.h +11/−0
• posix-api.cabal +106/−0
• src-linux/Posix/Socket/Platform.hsc +102/−0
• src/Linux/Socket.hs +6/−0
• src/Linux/Socket/Types.hsc +14/−0
• src/Posix/Directory.hs +68/−0
• src/Posix/Socket.hs +602/−0
• src/Posix/Socket/Types.hsc +203/−0
• test/Main.hs +98/−0

@@ -0,0 +1,5 @@+# Revision history for posix++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2018, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,21 @@+#include <sys/socket.h>+#include "HaskellPosix.h"++// Generally, this library tries to avoid wrapping POSIX functions+// in an additional function. However, for some functions whose wrappers+// unsafe FFI wrappers use unpinned ByteArray instead of Addr, the only+// way to support providing an offset (without just copying the bytes+// 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);+}+ssize_t send_offset(int socket, const char *buffer, int offset, size_t length, int flags) {+  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);+}+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);+}

@@ -0,0 +1,11 @@+#include <sys/types.h>+#include <sys/socket.h>++ssize_t recv_offset(int socket, char *buffer, int offset, size_t length, int flags);+ssize_t send_offset(int socket, const char *buffer, int offset, size_t length, int 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);+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);+++

@@ -0,0 +1,106 @@+cabal-version: 2.2+name: posix-api+version: 0.1.0.0+synopsis: posix bindings+description:+  This library provides a very thin wrapper around POSIX APIs. It can be+  compiled on any operating system that implements the standard as specified+  in <http://pubs.opengroup.org/onlinepubs/9699919799/ IEEE Std 1003.1>+  faithfully. It has similar goals as the `unix` package, but its design+  differs in several areas:+  .+  * `ByteArray` and `Addr` are used pervasively. There is no use of+    `String` in this library.+  .+  * Functions do not throw errors. This library uses `IO (Either Errno a)`+    in places where `unix` would use `IO a`.+  .+  * The numeric types from `Foreign.C.Types` and `System.Posix.Types` are+    used in the type signatures of functions so that a haskell function's+    type signature matches its underlying POSIX equivalent exactly.+  .+  * Flags are newtypes over `CInt` (or whatever integral type matches the+    posix specification) rather than enumerations. The data constructors+    are exported, making the types extensible for operating system that+    have additional flags.+  .+  About a dozen other packages offers wrappers for some subset of the POSIX+  specification are strewn across hackage. They include `regex-posix`,+  `posix-paths`, `posix-timer`, `posix-socket`, `posix-filelock`,+  `posix-acl`, etc. This library differs from all off these in various+  ways. Here are some of the design guidelines followed here that distinguish+  this package from some or all of these others:+  .+  * Scope. Although this library does not include all APIs specified by+    POSIX, it welcomes as many of them as anyone is willing to implement.+  .+  * Monomorphization. Effectful functions in this library return their+    results in `IO` rather than using a type that involves `MonadIO`+    or `MonadBaseControl`.+  .+  * Typeclass avoidance. This library does not introduce new typeclasses.+    Overloading is eschewed in favor of providing multiple functions+    with distinct names.+  .+  * Minimality. Functions wrapping the POSIX APIs do little more than+    wrap the underlying functions. The major deviation here is that,+    when applicable, the wrappers allocate buffers are the underlying+    functions fill. This eschews C's characteristic buffer-passing+    in favor of the Haskell convention of allocating internally and returning.+    A more minor deviation is that for safe FFI calls, this library+    will perform additional work to ensure that only pinned byte arrays are+    handed over.+  .+  Unlike `network`, this sockets API in this library does not integrate+  sockets with GHC's event manager. This is geared+  toward an audience that understands how to use `threadWaitRead`+  and `threadWaitWrite` with unsafe FFI calls to avoid blocking+  the runtime.+homepage: https://github.com/andrewthad/posix-api+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2018 Andrew Martin+category: System+build-type: Simple+extra-source-files:+  CHANGELOG.md+  cbits/HaskellPosix.c+  include/HaskellPosix.h++library+  exposed-modules:+    Linux.Socket+    Posix.Directory+    Posix.Socket+  other-modules:+    Linux.Socket.Types+    Posix.Socket.Types+    Posix.Socket.Platform+  build-depends:+    , base >=4.11.1 && <5+    , primitive >= 0.6.4+  hs-source-dirs: src+  if os(linux)+    hs-source-dirs: src-linux+  default-language: Haskell2010+  ghc-options: -Wall -O2+  c-sources: cbits/HaskellPosix.c+  include-dirs: include+  includes: HaskellPosix.h+  build-tools: hsc2hs++test-suite test+  type: exitcode-stdio-1.0+  hs-source-dirs: test+  main-is: Main.hs+  build-depends:+    , base+    , posix-api+    , tasty+    , tasty-hunit+    , primitive+  ghc-options: -Wall -O2 -threaded+  default-language: Haskell2010+

@@ -0,0 +1,102 @@+{-# language BangPatterns #-}+{-# language DerivingStrategies #-}+{-# language DuplicateRecordFields #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language MagicHash #-}+{-# language NamedFieldPuns #-}+{-# language UnboxedTuples #-}+{-# language ScopedTypeVariables #-}++#include <sys/types.h>+#include <sys/socket.h>+#include <netinet/in.h>+#include <netinet/ip.h>+#include <arpa/inet.h>++-- | All of the data constructors provided by this module are unsafe.+--   Only use them if you really know what you are doing.+module Posix.Socket.Platform+  ( -- * Encoding Socket Addresses+    encodeSocketAddressInternet+  , encodeSocketAddressUnix+  ) where++import Data.Primitive (ByteArray(..),Addr(..))+import Data.Void (Void)+import Data.Word (Word8)+import Foreign.C.Types (CUShort)+import Foreign.Storable (pokeByteOff)+import GHC.Exts (ByteArray##,State##,RealWorld,Ptr(..),runRW##,touch##)+import GHC.IO (IO(..))+import Posix.Socket.Types (SocketAddressInternet(..),SocketAddressUnix(..))+import Posix.Socket.Types (SocketAddress(..))+import Control.Monad (when)++import qualified Data.Primitive as PM+import qualified Foreign.Storable as FS++-- | 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}) =+  SocketAddress $ runByteArrayIO $ unboxByteArrayIO $ do+    bs <- PM.newPinnedByteArray #{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)+    let !(Addr addr) = PM.mutableByteArrayContents bs+    let !(ptr :: Ptr Void) = Ptr addr+    -- 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.+    #{poke struct sockaddr_in, sin_family} ptr (#{const AF_INET} :: CUShort)+    -- The port and the address are already supposed to be in network+    -- byte order in the SocketAddressInternet data type.+    #{poke struct sockaddr_in, sin_port} ptr port+    #{poke struct sockaddr_in, sin_addr.s_addr} ptr address+    r <- PM.unsafeFreezeByteArray bs+    touchByteArray r+    pure r++-- | 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+--   to 108 but varies by platform), the socket address will instead be given the+--   empty string as its path. This typically results in @bind@ returning an+--   error code.+encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress+encodeSocketAddressUnix (SocketAddressUnix !name) =+  SocketAddress $ runByteArrayIO $ unboxByteArrayIO $ do +    -- On linux, sun_path always has exactly 108 bytes. It is a null-terminated+    -- string, so we initialize the byte array to zeroes to ensure this+    -- happens.+    let pathSize = 108 :: Int+    -- Again, we hard-code the size of sa_family_t as the size of+    -- an unsigned short.+    let familySize = FS.sizeOf (undefined :: CUShort)+    bs <- PM.newPinnedByteArray (pathSize + familySize)+    PM.setByteArray bs familySize pathSize (0 :: Word8)+    PM.writeByteArray bs 0 (#{const AF_UNIX} :: CUShort)+    let sz = PM.sizeofByteArray name+    when (sz < pathSize) $ do+      PM.copyByteArray bs familySize name 0 sz+    PM.unsafeFreezeByteArray bs++touchByteArray :: ByteArray -> IO ()+touchByteArray (ByteArray x) = touchByteArray## x++touchByteArray## :: ByteArray## -> IO ()+touchByteArray## x = IO $ \s -> case touch## x s of s' -> (## s', () ##)++unboxByteArrayIO :: IO ByteArray -> State## RealWorld -> (## State## RealWorld, ByteArray## ##)+unboxByteArrayIO (IO f) s = case f s of+  (## s', ByteArray b ##) -> (## s', b ##)++-- In a general setting, this function is unsafe, but it is used kind of like+-- runST in this module.+runByteArrayIO :: (State## RealWorld -> (## State## RealWorld, ByteArray## ##)) -> ByteArray+runByteArrayIO st_rep = case runRW## st_rep of (## _, a ##) -> ByteArray a+

@@ -0,0 +1,6 @@+module Linux.Socket+  ( -- * Flags+    LST.dontWait+  ) where++import qualified Linux.Socket.Types as LST

@@ -0,0 +1,14 @@+#include <sys/socket.h>++-- | All of the data constructors provided by this module are unsafe.+--   Only use them if you really know what you are doing.+module Linux.Socket.Types+  ( dontWait+  ) where++import Posix.Socket (Flags(..))++-- | The @MSG_DONTWAIT@ receive flag or send flag.+dontWait :: Flags m+dontWait = Flags #{const MSG_DONTWAIT}+

@@ -0,0 +1,68 @@+{-# language BangPatterns #-}+{-# language MagicHash #-}+{-# language LambdaCase #-}+{-# language UnboxedTuples #-}++module Posix.Directory+  ( getCurrentWorkingDirectory+  ) where++import Data.Primitive (Addr(..),ByteArray)+import GHC.Exts (Ptr(..))+import Foreign.Ptr (nullPtr)+import Foreign.C.Error (Errno,eRANGE,getErrno)+import Foreign.C.Types (CChar,CSize(..))+import GHC.IO (IO(..))++import qualified Data.Primitive as PM+import qualified Foreign.Storable as FS++foreign import ccall safe "getcwd"+  c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar)++-- | Get the current working directory without using the system locale+--   to convert it to text. This is implemented with a safe FFI call+--   since it may block.+getCurrentWorkingDirectory :: IO (Either Errno ByteArray)+getCurrentWorkingDirectory = go (4096 - chunkOverhead) where+  go !sz = do+    -- It may be nice to add a variant of getCurrentWorkingDirectory that+    -- allow the user to supply an initial pinned buffer. I'm not sure+    -- how many other POSIX functions there are that could benefit+    -- from this. Calls to getCurrentWorkingDirectory are extremely rare,+    -- so there would be little benefit here, but there may be other+    -- functions where these repeated 4KB allocations might trigger+    -- GC very quickly.+    marr <- PM.newPinnedByteArray sz+    let !(Addr addr) = PM.mutableByteArrayContents marr+    ptr <- c_getcwd (Ptr addr) (intToCSize sz)+    -- We probably want to use touch# or with# here.+    if ptr /= nullPtr+      then do+        strSize <- findNullByte ptr+        dst <- PM.newByteArray strSize+        PM.copyMutableByteArray dst 0 marr 0 strSize+        dst' <- PM.unsafeFreezeByteArray dst+        pure (Right dst')+      else do+        errno <- getErrno+        if errno == eRANGE+          then go (2 * sz)+          else fmap Left getErrno++chunkOverhead :: Int+chunkOverhead = 2 * PM.sizeOf (undefined :: Int)++intToCSize :: Int -> CSize+intToCSize = fromIntegral++-- There must be a null byte present or bad things will happen.+-- This will return a nonnegative number.+findNullByte :: Ptr CChar -> IO Int+findNullByte = go 0 where+  go :: Int -> Ptr CChar -> IO Int+  go !ix !ptr = do+    FS.peekElemOff ptr ix >>= \case+      0 -> pure ix+      _ -> go (ix + 1) ptr+

@@ -0,0 +1,602 @@+{-# language BangPatterns #-}+{-# language DataKinds #-}+{-# language InterruptibleFFI #-}+{-# language MagicHash #-}+{-# language ScopedTypeVariables #-}+{-# language UnboxedTuples #-}+{-# language UnliftedFFITypes #-}++-- | Types and functions related to the POSIX sockets API.+--   Unusual characteristics:+--+--   * Any time the standard calls for @socklen_t@, we use+--     @CInt@ instead. Linus Torvalds <https://yarchive.net/comp/linux/socklen_t.html writes>+--     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@+--     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.+module Posix.Socket+  ( -- * Functions+    -- ** Socket+    socket+    -- ** Socket Pair+  , socketPair+    -- ** Bind+  , bind+    -- ** Connect+  , connect+    -- ** Listen+  , listen+    -- ** Accept+  , accept+  , accept_+    -- ** Close+  , close+  , unsafeClose+    -- ** Send+  , send+  , sendByteArray+  , sendMutableByteArray+  , unsafeSend+  , unsafeSendByteArray+  , unsafeSendMutableByteArray+    -- ** Send To+  , unsafeSendToByteArray+  , unsafeSendToMutableByteArray+    -- ** Receive+  , receive+  , receiveByteArray+  , unsafeReceive+  , unsafeReceiveMutableByteArray+    -- ** Receive From+  , unsafeReceiveFromMutableByteArray+  , unsafeReceiveFromMutableByteArray_+    -- * Types+  , Domain(..)+  , Type(..)+  , Protocol(..)+  , Flags(..)+    -- * Socket Address+    -- ** Types+  , SocketAddress(..)+  , PST.SocketAddressInternet(..)+  , PST.SocketAddressUnix(..)+    -- ** Encoding+  , PSP.encodeSocketAddressInternet+  , PSP.encodeSocketAddressUnix+    -- * Data Construction+    -- ** Socket Domains+  , PST.unix+  , PST.unspecified+  , PST.internet+    -- ** Socket Types+  , PST.stream+  , PST.datagram+  , PST.raw+  , PST.sequencedPacket+    -- ** Protocols+  , PST.defaultProtocol+  , PST.rawProtocol+  , PST.icmp+  , PST.tcp+  , PST.udp+  , PST.ip+  , PST.ipv6+    -- ** Receive Flags+  , PST.peek+  , PST.outOfBand+  , PST.waitAll+  ) where++import GHC.IO (IO(..))+import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),Addr(..),ByteArray(..))+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#)+import Posix.Socket.Types (Domain(..),Protocol(..),Type(..),SocketAddress(..))+import Posix.Socket.Types (Flags(..),Message(..))+import System.Posix.Types (Fd(..),CSsize(..))++import qualified Posix.Socket.Types as PST+import qualified Data.Primitive as PM++-- This module include operating-system specific code used+-- to serialize some of various kind of socket address types.+import qualified Posix.Socket.Platform as PSP++foreign import ccall unsafe "sys/socket.h socket"+  c_socket :: Domain -> Type -> Protocol -> IO Fd++foreign import ccall unsafe "sys/socket.h socketpair"+  c_socketpair :: Domain -> Type -> Protocol -> MutableByteArray# RealWorld -> IO CInt++foreign import ccall unsafe "sys/socket.h listen"+  c_listen :: Fd -> CInt -> IO CInt++foreign import ccall interruptible "unistd.h close"+  c_safe_close :: Fd -> IO CInt++foreign import ccall unsafe "unistd.h close"+  c_unsafe_close :: Fd -> IO CInt++-- Per the spec, the type signature of bind is:+--   int bind(int socket, const struct sockaddr *address, socklen_t address_len);+-- However, here we choose to represent the third argument as+-- CInt rather than introducing a type corresponding to socklen_t.+-- According to Linus Torvalds, "Any sane library must have socklen_t+-- be the same size as int. Anything else breaks any BSD socket layer stuff."+-- (https://yarchive.net/comp/linux/socklen_t.html). If a platform+-- violates this assumption, this wrapper will be broken on that platform.+foreign import ccall unsafe "sys/socket.h bind"+  c_bind :: Fd -> ByteArray# -> CInt -> IO CInt++-- Per the spec, the type signature of accept is:+--   int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);+-- The restrict keyword does not matter much for our purposes. See the+-- note on c_bind for why we use CInt for socklen_t. Remember that the+-- first bytearray argument is actually SocketAddress in the function that+-- wraps this one. The second bytearray argument is a pointer to the size.+foreign import ccall interruptible "sys/socket.h accept"+  c_safe_accept :: Fd+                -> MutableByteArray# RealWorld -- SocketAddress+                -> MutableByteArray# RealWorld -- Ptr CInt+                -> IO Fd+foreign import ccall interruptible "sys/socket.h accept"+  c_safe_ptr_accept :: Fd -> Ptr Void -> Ptr CInt -> IO Fd++-- 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.+foreign import ccall interruptible "sys/socket.h connect"+  c_safe_connect :: Fd -> ByteArray# -> CInt -> IO CInt++-- There are several options for wrapping send. Both safe and unsafe+-- are useful. Additionally, in the unsafe category, we also+-- have the option of writing to either an address or a byte array.+-- Unsafe FFI calls guarantee that byte arrays will not be relocated+-- while the FFI call is taking place. Safe FFI calls do not have+-- this guarantee, so internally we must be careful when using these to only+-- provide pinned byte arrays as arguments.+foreign import ccall interruptible "sys/socket.h send"+  c_safe_addr_send :: Fd -> Addr# -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall interruptible "sys/socket.h send_offset"+  c_safe_bytearray_send :: Fd -> ByteArray# -> CInt -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall interruptible "sys/socket.h send_offset"+  c_safe_mutablebytearray_send :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall interruptible "sys/socket.h send"+  c_safe_mutablebytearray_no_offset_send :: Fd -> MutableByteArray# RealWorld -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall unsafe "sys/socket.h send"+  c_unsafe_addr_send :: Fd -> Addr# -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall unsafe "sys/socket.h send_offset"+  c_unsafe_bytearray_send :: Fd -> ByteArray# -> CInt -> CSize -> Flags 'Send -> IO CSsize+foreign import ccall unsafe "sys/socket.h send_offset"+  c_unsafe_mutable_bytearray_send :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Send -> IO CSsize++-- The ByteArray# (second to last argument) is a SocketAddress.+foreign import ccall unsafe "sys/socket.h sendto_offset"+  c_unsafe_bytearray_sendto :: Fd -> ByteArray# -> CInt -> CSize -> Flags 'Send -> ByteArray# -> CInt -> IO CSsize+-- The ByteArray# (second to last argument) is a SocketAddress.+foreign import ccall unsafe "sys/socket.h sendto_offset"+  c_unsafe_mutable_bytearray_sendto :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Send -> ByteArray# -> CInt -> IO CSsize++-- There are several ways to wrap recv.+foreign import ccall interruptible "sys/socket.h recv"+  c_safe_addr_recv :: Fd -> Addr# -> CSize -> Flags 'Receive -> IO CSsize+foreign import ccall unsafe "sys/socket.h recv"+  c_unsafe_addr_recv :: Fd -> Addr# -> CSize -> Flags 'Receive -> IO CSsize+foreign import ccall unsafe "sys/socket.h recv_offset"+  c_unsafe_mutable_byte_array_recv :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Receive -> IO CSsize++-- The last two arguments are SocketAddress and Ptr CInt.+foreign import ccall unsafe "sys/socket.h recvfrom_offset"+  c_unsafe_mutable_byte_array_recvfrom :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Receive -> MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> IO CSsize+foreign import ccall unsafe "sys/socket.h recvfrom_offset"+  c_unsafe_mutable_byte_array_ptr_recvfrom :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> Flags 'Receive -> Ptr Void -> Ptr CInt -> 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>+--   includes more details. This is implemented as an unsafe FFI+--   call since the author believes that it cannot block indefinitely.+socket ::+     Domain -- ^ Communications domain (e.g. 'internet', 'unix')+  -> Type -- ^ Socket type (e.g. 'datagram', 'stream')+  -> Protocol -- ^ Protocol+  -> IO (Either Errno Fd)+socket dom typ prot = c_socket dom typ prot >>= errorsFromFd++-- | Create an unbound pair of connected sockets in a specified domain, of+--   a specified type, under the protocol optionally specified by the protocol+--   argument. The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/socketpair.html POSIX specification>+--   includes more details. This is implemented as an unsafe FFI call+--   since the author believes that it cannot block indefinitely.+socketPair ::+     Domain -- ^ Communications domain (probably 'unix')+  -> Type -- ^ Socket type (e.g. 'datagram', 'stream')+  -> Protocol -- ^ Protocol+  -> IO (Either Errno (Fd,Fd))+socketPair dom typ prot = do+  -- If this ever switches to the safe FFI, we will need to use+  -- a pinned array here instead.+  (sockets@(MutablePrimArray sockets#) :: MutablePrimArray RealWorld Fd) <- PM.newPrimArray 2+  r <- c_socketpair dom typ prot sockets#+  if r == 0+    then do+      fd1 <- PM.readPrimArray sockets 0+      fd2 <- PM.readPrimArray sockets 1+      pure (Right (fd1,fd2))+    else fmap Left getErrno++-- | Assign a local socket address address to a socket identified by+--   descriptor socket that has no local socket address assigned. The+--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/bind.html POSIX specification>+--   includes more details. The 'SocketAddress' represents the @sockaddr@ pointer argument, together+--   with its @socklen_t@ size, as a byte array. This allows @bind@ to+--   be used with @sockaddr@ extensions on various platforms. This uses+--   the unsafe FFI since the author believes it cannot block indefinitely.+bind ::+     Fd -- ^ Socket+  -> SocketAddress -- ^ Socket address, extensible tagged union+  -> IO (Either Errno ())+bind fd (SocketAddress b@(ByteArray b#)) =+  c_bind fd b# (intToCInt (PM.sizeofByteArray b)) >>= errorsFromInt++-- | Mark the socket as a passive socket, that is, as a socket that+--   will be used to accept incoming connection requests using @accept@.+--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/listen.html POSIX specification>+--   includes more details. Listen uses the unsafe FFI since it cannot block+--   and always returns promptly.+listen ::+     Fd -- ^ Socket+  -> CInt -- ^ Backlog+  -> IO (Either Errno ())+listen fd backlog = c_listen fd backlog >>= errorsFromInt++-- | Connect the socket to the specified socket address.+--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html POSIX specification>+--   includes more details. An @unsafeConnect@ using the unsafe FFI is+--   not provided since there is no way to hook such a beast into the+--   event manager.+connect ::+     Fd -- ^ Fd+  -> SocketAddress -- ^ Socket address, extensible tagged union+  -> IO (Either Errno ())+connect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =+  c_safe_connect fd sockAddr# (intToCInt (PM.sizeofByteArray sockAddr)) >>= errorsFromInt++-- | Extract the first connection on the queue of pending connections. The+--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>+--   includes more details. This function\'s type differs slightly from+--   the specification:+--+--   > int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);+--+--   Instead of requiring the caller to prepare buffers through which+--   information is returned, this haskell binding to @accept@ prepares+--   those buffers internally. This eschews C\'s characteristic buffer-passing+--   in favor of the Haskell convention of allocating internally and returning.+--+--   More specifically, this binding lacks an argument corresponding to the+--   @sockaddr@ buffer from the specification. That mutable buffer is allocated+--   internally, resized and frozen upon a success, and returned along with+--   the file descriptor of the accepted socket. The size of this buffer is+--   determined by the second argument (maximum socket address size). This+--   size argument is also writen to the @address_len@ buffer, which is also+--   allocated internally. The size returned through this pointer is used to+--   resize the @sockaddr@ buffer, which is then frozen so that an immutable+--   'SocketAddress' is returned to the end user.+--+--   For applications uninterested in the peer (described by @sockaddr@),+--   POSIX @accept@ allows the null pointer to be passed as both @address@ and+--   @address_len@. This behavior is provided by 'accept_'.+accept ::+     Fd -- ^ Listening socket+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (SocketAddress,Fd)) -- ^ Peer information and connected socket+accept sock maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newPinnedByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newPinnedByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_safe_accept sock sockAddrBuf# lenBuf#+  if r > (-1)+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      sockAddr <- PM.unsafeFreezeByteArray =<< PM.resizeMutableByteArray sockAddrBuf (cintToInt sz)+      pure (Right (SocketAddress sockAddr,r))+    else fmap Left getErrno++-- | A variant of 'accept' that does not provide the user with a+--   'SocketAddress' detailing the peer.+accept_ ::+     Fd -- ^ Listening socket+  -> IO (Either Errno Fd) -- ^ Connected socket+accept_ sock =+  c_safe_ptr_accept sock nullPtr nullPtr >>= errorsFromFd++-- | Send data from a 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 interruptible+--   FFI, it allocates a pinned copy of the bytearry if it was not+--   already pinned.+sendByteArray ::+     Fd -- ^ Socket+  -> ByteArray -- ^ Source byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+sendByteArray fd b@(ByteArray b#) off len flags = if PM.isByteArrayPinned b+  then errorsFromSize =<< c_safe_bytearray_send fd b# off len flags+  else do+    x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)+    PM.copyByteArray x (cintToInt off) b 0 (csizeToInt len)+    errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags++-- | 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 interruptible+--   FFI, it allocates a pinned copy of the bytearry if it was not+--   already pinned.+sendMutableByteArray ::+     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Source byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+sendMutableByteArray fd b@(MutableByteArray b#) off len flags = if PM.isMutableByteArrayPinned b+  then errorsFromSize =<< c_safe_mutablebytearray_send fd b# off len flags+  else do+    x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)+    PM.copyMutableByteArray x (cintToInt off) b 0 (csizeToInt len)+    errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags++-- | Send data from an address over a network socket. This is not guaranteed+--   to send the entire length. This uses the safe interruptible FFI since+--   it may block indefinitely.+send ::+     Fd -- ^ Connected socket+  -> Addr -- ^ Source address+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+send fd (Addr addr) len flags =+  c_safe_addr_send fd addr len flags >>= errorsFromSize++-- | Send data from an address over a network socket. This uses the unsafe FFI.+--   Users of this function should be sure to set flags that prohibit this+--   from blocking. On Linux this is accomplished with @O_NONBLOCK@. It is+--   often desirable to call 'threadWaitWrite' on a nonblocking socket before+--   calling @unsafeSend@ on it.+unsafeSend ::+     Fd -- ^ Socket+  -> Addr -- ^ Source address+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+unsafeSend fd (Addr addr) len flags =+  c_unsafe_addr_send fd addr len flags >>= errorsFromSize++-- | Send data from a byte array over a network socket. This uses the unsafe FFI;+--   considerations pertaining to 'sendUnsafe' apply to this function as well. Users+--   may specify a length to send fewer bytes than are actually present in the+--   array.+unsafeSendByteArray ::+     Fd -- ^ Socket+  -> ByteArray -- ^ Source byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+unsafeSendByteArray fd (ByteArray b) off len flags =+  c_unsafe_bytearray_send fd b off len flags >>= errorsFromSize++-- | Send data from a mutable byte array over a network socket. This uses the unsafe FFI;+--   considerations pertaining to 'sendUnsafe' apply to this function as well. Users+--   specify an offset and a length to send fewer bytes than are actually present in the+--   array.+unsafeSendMutableByteArray ::+     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Source mutable byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+unsafeSendMutableByteArray fd (MutableByteArray b) off len flags =+  c_unsafe_mutable_bytearray_send fd b off len flags >>= errorsFromSize++-- | Send data from a byte array over an unconnected network socket.+--   This uses the unsafe FFI; considerations pertaining to 'sendToUnsafe'+--   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.+unsafeSendToByteArray :: +     Fd -- ^ Socket+  -> ByteArray -- ^ Source byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> SocketAddress -- ^ Socket Address+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+unsafeSendToByteArray fd (ByteArray b) off len flags (SocketAddress a@(ByteArray a#)) =+  c_unsafe_bytearray_sendto fd b off len flags a# (intToCInt (PM.sizeofByteArray a)) >>= errorsFromSize++-- | Send data from a mutable byte array over an unconnected network socket.+--   This uses the unsafe FFI; considerations pertaining to 'sendToUnsafe'+--   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.+unsafeSendToMutableByteArray :: +     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Source byte array+  -> CInt -- ^ Offset into source array+  -> CSize -- ^ Length in bytes+  -> Flags 'Send -- ^ Flags+  -> SocketAddress -- ^ Socket Address+  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+unsafeSendToMutableByteArray fd (MutableByteArray b) off len flags (SocketAddress a@(ByteArray a#)) =+  c_unsafe_mutable_bytearray_sendto fd b off len flags a# (intToCInt (PM.sizeofByteArray a)) >>= errorsFromSize++-- | Receive data into an address from a network socket. This wraps @recv@ using+--   the safe interruptible FFI. When the returned size is zero, there are no+--   additional bytes to receive and the peer has performed an orderly shutdown.+receive ::+     Fd -- ^ Socket+  -> Addr -- ^ Source address+  -> CSize -- ^ Length in bytes+  -> Flags 'Receive -- ^ Flags+  -> IO (Either Errno CSize)+receive fd (Addr addr) len flags =+  c_safe_addr_recv fd addr len flags >>= errorsFromSize++-- | Receive data into a byte array from a network socket. This wraps @recv@ using+--   the safe interruptible FFI. When the returned size is zero, there are no+--   additional bytes to receive and the peer has performed an orderly shutdown.+receiveByteArray ::+     Fd -- ^ Socket+  -> CSize -- ^ Length in bytes+  -> Flags 'Receive -- ^ Flags+  -> IO (Either Errno ByteArray)+receiveByteArray fd len flags = do+  m <- PM.newPinnedByteArray (csizeToInt len)+  let !(Addr addr) = PM.mutableByteArrayContents m+  r <- c_safe_addr_recv fd addr len flags+  if r /= (-1)+    then do+      -- Why copy when we could just shrink? We want to always return+      -- byte arrays that are not explicitly pinned.+      let sz = cssizeToInt r+      x <- PM.newByteArray sz+      PM.copyMutableByteArray x 0 m 0 sz+      a <- PM.unsafeFreezeByteArray x+      pure (Right a)+    else fmap Left getErrno++-- | Receive data into an address from a network socket. This wraps @recv@+--   using the unsafe FFI. Users of this function should be sure to set flags+--   that prohibit this from blocking. On Linux this is accomplished by setting+--   the @MSG_DONTWAIT@ flag and handling the resulting @EAGAIN@ or+--   @EWOULDBLOCK@. When the returned size is zero, there are no additional+--   bytes to receive and the peer has performed an orderly shutdown.+unsafeReceive ::+     Fd -- ^ Socket+  -> Addr -- ^ Source address+  -> CSize -- ^ Length in bytes+  -> Flags 'Receive -- ^ Flags+  -> IO (Either Errno CSize)+unsafeReceive fd (Addr addr) len flags =+  c_unsafe_addr_recv fd addr len flags >>= errorsFromSize++-- | Receive data into an address from a network socket. This uses the unsafe+--   FFI; considerations pertaining to 'receiveUnsafe' apply to this function+--   as well. Users may specify a length to receive fewer bytes than are+--   actually present in the mutable byte array.+unsafeReceiveMutableByteArray ::+     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Destination byte array+  -> CInt -- ^ Destination offset+  -> CSize -- ^ Maximum bytes to receive+  -> Flags 'Receive -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Bytes received into array+unsafeReceiveMutableByteArray fd (MutableByteArray b) off len flags =+  c_unsafe_mutable_byte_array_recv fd b off len flags >>= errorsFromSize++-- | Receive data into an address from an unconnected network socket. This uses the unsafe+--   FFI. Users may specify an offset into the destination byte array.+unsafeReceiveFromMutableByteArray ::+     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Destination byte array+  -> CInt -- ^ Destination offset+  -> CSize -- ^ Maximum bytes to receive+  -> Flags 'Receive -- ^ Flags+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (SocketAddress,CSize)) -- ^ Remote host, umber of bytes received into array+unsafeReceiveFromMutableByteArray fd (MutableByteArray b) off len flags maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newPinnedByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newPinnedByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_unsafe_mutable_byte_array_recvfrom fd b off len flags sockAddrBuf# lenBuf#+  if r > (-1)+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      sockAddr <- PM.unsafeFreezeByteArray =<< PM.resizeMutableByteArray sockAddrBuf (cintToInt sz)+      pure (Right (SocketAddress sockAddr,cssizeToCSize r))+    else fmap Left getErrno++-- | Receive data into an address from a network socket. This uses the unsafe+--   FFI. This does not return the socket address of the remote host that+--   sent the packet received.+unsafeReceiveFromMutableByteArray_ ::+     Fd -- ^ Socket+  -> MutableByteArray RealWorld -- ^ Destination byte array+  -> CInt -- ^ Destination offset+  -> CSize -- ^ Maximum bytes to receive+  -> Flags 'Receive -- ^ Flags+  -> IO (Either Errno CSize) -- ^ Number of bytes received into array+unsafeReceiveFromMutableByteArray_ fd (MutableByteArray b) off len flags =+  c_unsafe_mutable_byte_array_ptr_recvfrom fd b off len flags nullPtr nullPtr >>= errorsFromSize++-- | Close a socket. The <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>+--   includes more details. This uses the safe interruptible FFI.+close ::+     Fd -- ^ Socket+  -> IO (Either Errno ())+close fd = c_safe_close fd >>= errorsFromInt++-- | Close a socket. This uses the unsafe FFI. According to the+--   <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>,+--   "If @fildes@ refers to a socket, @close()@ shall cause the socket to+--   be destroyed. If the socket is in connection-mode, and the @SO_LINGER@+--   option is set for the socket with non-zero linger time, and the socket+--   has untransmitted data, then @close()@ shall block for up to the current+--   linger interval until all data is transmitted."+unsafeClose ::+     Fd -- ^ Socket+  -> IO (Either Errno ())+unsafeClose fd = c_unsafe_close fd >>= errorsFromInt++errorsFromSize :: CSsize -> IO (Either Errno CSize)+errorsFromSize r = if r > (-1)+  then pure (Right (cssizeToCSize r))+  else fmap Left getErrno++errorsFromFd :: Fd -> IO (Either Errno Fd)+errorsFromFd r = if r > (-1)+  then pure (Right r)+  else fmap Left getErrno++-- Sometimes, functions that return an int use zero to indicate+-- success and negative one to indicate failure without including+-- additional information in the value.+errorsFromInt :: CInt -> IO (Either Errno ())+errorsFromInt r = if r == 0+  then pure (Right ())+  else fmap Left getErrno++intToCInt :: Int -> CInt+intToCInt = fromIntegral++cintToInt :: CInt -> Int+cintToInt = fromIntegral++csizeToInt :: CSize -> Int+csizeToInt = fromIntegral++cssizeToInt :: CSsize -> Int+cssizeToInt = fromIntegral++-- only call this when it is known that the argument is non-negative+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', () #)+

@@ -0,0 +1,203 @@+{-# language DataKinds #-}+{-# language DerivingStrategies #-}+{-# language DuplicateRecordFields #-}+{-# language GADTSyntax #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language KindSignatures #-}++#include <sys/socket.h>+#include <netinet/in.h>++-- | All of the data constructors provided by this module are unsafe.+--   Only use them if you really know what you are doing.+module Posix.Socket.Types+  ( Domain(..)+  , Type(..)+  , Protocol(..)+  , SocketAddress(..)+  , SocketAddressInternet(..)+  , SocketAddressInternet6(..)+  , SocketAddressUnix(..)+  , Flags(..)+  , Message(..)+    -- * Socket Families+  , unix+  , unspecified+  , internet+    -- * Socket Types+  , stream+  , datagram+  , raw+  , sequencedPacket+    -- * Protocols+  , defaultProtocol+  , rawProtocol+  , icmp+  , tcp+  , udp+  , ip+  , ipv6+    -- * Receive Flags+  , peek+  , outOfBand+  , waitAll+  ) where++import Foreign.C.Types (CInt(..))+import Data.Primitive (ByteArray)+import Data.Bits (Bits,(.|.))+import Data.Word (Word16,Word32,Word64)+import qualified Data.Kind++-- | A socket communications domain, sometimes referred to as a family. The spec+--   mandates @AF_UNIX@, @AF_UNSPEC@, and @AF_INET@.+newtype Domain = Domain CInt++-- | A socket type. The spec mandates @SOCK_STREAM@, @SOCK_DGRAM@,+--   and @SOCK_SEQPACKET@. Other types may be available on a per-platform+--   basis.+newtype Type = Type CInt++newtype Protocol = Protocol CInt++-- | The direction of a message. The data constructor are only used+--   at the type level as phantom arguments.+data Message = Send | Receive++-- | Receive flags are given by @Flags Receive@ and send flags+--   are given by @Flags Send@. This is done because there are+--   several flags that are applicable in either a receiving+--   context or a sending context.+newtype Flags :: Message -> Data.Kind.Type where+  Flags :: CInt -> Flags m+  deriving stock (Eq)+  deriving newtype (Bits)++instance Semigroup (Flags m) where (<>) = (.|.)+instance Monoid (Flags m) where mempty = Flags 0++-- | 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.+--   The byte array representing the socket address must be pinned+--   since @bind@ uses a safe FFI call.+newtype SocketAddress = SocketAddress ByteArray++-- | An address for an Internet socket over IPv4. The+--   <http://pubs.opengroup.org/onlinepubs/000095399/basedefs/netinet/in.h.html POSIX specification>+--   mandates three fields:+--+--   > sa_family_t     sin_family   AF_INET+--   > in_port_t       sin_port     Port number+--   > struct in_addr  sin_addr     IP address+--+--   This type omits the first field since is a constant that+--   is only relevant for serialization purposes. The spec also+--   mandates that @sin_port@ and @sin_addr@ be in network+--   byte order, so keep in mind that these values are not+--   immidiately useable.+data SocketAddressInternet = SocketAddressInternet+  { port :: !Word16+  , address :: !Word32+  }++-- Revisit this. We really need a standard Word128 type somewhere.+data SocketAddressInternet6 = SocketAddressInternet6+  { port :: !Word16+  , flowInfo :: !Word32+  , addressA :: !Word64+  , addressB :: !Word64+  , scopeId :: !Word32+  }++-- | An address for a UNIX domain socket. The+--   <http://pubs.opengroup.org/onlinepubs/009604499/basedefs/sys/un.h.html POSIX specification>+--   mandates two fields:+--+--   > sa_family_t  sun_family  Address family. +--   > char         sun_path[]  Socket pathname. +--+--   However, the first field is omitted since it is always @AF_UNIX@.+--   It is adding during serialization. Although @sun_path@ is a+--   null-terminated string, @SocketAddressUnix@ should not have+--   a trailing null byte. The conversion function @encodeSocketAddressUnix@+--   adds the null terminator. The size of path should not equal+--   or exceed the platform-dependent size of @sun_path@.+newtype SocketAddressUnix = SocketAddressUnix+  { path :: ByteArray+  }++-- | The @SOCK_STREAM@ socket type.+stream :: Type+stream = Type #{const SOCK_STREAM}++-- | The @SOCK_DGRAM@ socket type.+datagram :: Type+datagram = Type #{const SOCK_DGRAM}++-- | The @SOCK_RAW@ socket type. POSIX declares raw sockets optional.+--   However, they are included here for convenience. Please open an+--   issue if this prevents this library from compiling on a+--   POSIX-compliant operating system that anyone uses for haskell+--   development. Keep in mind that even though raw sockets may exist+--   on all POSIX-compliant operating systems, they may differ in+--   their behavior.+raw :: Type+raw = Type #{const SOCK_RAW}++-- | The @SOCK_SEQPACKET@ socket type.+sequencedPacket :: Type+sequencedPacket = Type #{const SOCK_SEQPACKET}++-- | The @AF_UNIX@ communications domain.+unix :: Domain+unix = Domain #{const AF_UNIX}++-- | The @AF_UNSPEC@ communications domain.+unspecified :: Domain+unspecified = Domain #{const AF_UNSPEC}++-- | The @AF_INET@ communications domain.+internet :: Domain+internet = Domain #{const AF_INET}++-- | The @MSG_OOB@ receive flag or send flag.+outOfBand :: Flags m+outOfBand = Flags #{const MSG_OOB}++-- | The @MSG_PEEK@ receive flag.+peek :: Flags 'Receive+peek = Flags #{const MSG_PEEK}++-- | The @MSG_WAITALL@ receive flag.+waitAll :: Flags 'Receive+waitAll = Flags #{const MSG_WAITALL}++-- | The default protocol for a socket type.+defaultProtocol :: Protocol+defaultProtocol = Protocol 0++-- | The @IPPROTO_RAW@ protocol.+rawProtocol :: Protocol+rawProtocol = Protocol #{const IPPROTO_RAW}++-- | The @IPPROTO_ICMP@ protocol.+icmp :: Protocol+icmp = Protocol #{const IPPROTO_ICMP}++-- | The @IPPROTO_TCP@ protocol.+tcp :: Protocol+tcp = Protocol #{const IPPROTO_TCP}++-- | The @IPPROTO_UDP@ protocol.+udp :: Protocol+udp = Protocol #{const IPPROTO_UDP}++-- | The @IPPROTO_IP@ protocol.+ip :: Protocol+ip = Protocol #{const IPPROTO_IP}++-- | The @IPPROTO_IPV6@ protocol.+ipv6 :: Protocol+ipv6 = Protocol #{const IPPROTO_IPV6}+

@@ -0,0 +1,98 @@+{-# language BangPatterns #-}+{-# 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.Monad (when)+import Foreign.C.Types (CInt,CSize)+import Control.Concurrent (threadWaitRead)++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++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests"+  [ testGroup "sockets"+    [ testCase "A" testSocketsA+    , testCase "B" testSocketsB+    , testCase "C" testSocketsC+    , testCase "D" testSocketsD+    ]+  ]++testSocketsA :: Assertion+testSocketsA = do+  (a,b) <- demand =<< S.socketPair 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+  when (bytesSent /= 5) (fail "testSocketsA: bytesSent was wrong")+  actual <- demand =<< PM.takeMVar m+  sample @=? actual++testSocketsB :: Assertion+testSocketsB = do+  let limit = 10+      wordSz = PM.sizeOf (undefined :: Int)+      cwordSz = fromIntegral wordSz :: CSize+  (a,b) <- demand =<< S.socketPair S.unix S.datagram S.defaultProtocol+  lock <- PM.newEmptyMVar+  let go1 !(ix :: Int) !(n :: Int) = if (ix < limit)+        then do+          y <- PM.newByteArray wordSz+          PM.writeByteArray y 0 (1 + n)+          z <- PM.unsafeFreezeByteArray y+          oneWord =<< demand =<< S.sendByteArray b z 0 cwordSz mempty+          x <- demand =<< S.receiveByteArray b cwordSz mempty+          go1 (ix + 1) (PM.indexByteArray x 0)+        else pure n+      go2 !(ix :: Int) = if (ix < limit)+        then do+          x <- demand =<< S.receiveByteArray a cwordSz mempty+          y <- PM.newByteArray wordSz+          PM.writeByteArray y 0 (1 + PM.indexByteArray x 0 :: Int) +          z <- PM.unsafeFreezeByteArray y+          oneWord =<< demand =<< S.sendByteArray a z 0 cwordSz mempty+          go2 (ix + 1)+        else PM.putMVar lock ()+  _ <- forkIO (go2 0)+  r <- go1 0 0+  PM.takeMVar lock+  20 @=? r++testSocketsC :: Assertion+testSocketsC = do+  (a,b) <- demand =<< S.socketPair 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+  when (bytesSent /= 5) (fail "testSocketsC: bytesSent was wrong")+  actual <- demand =<< PM.takeMVar m+  sample @=? actual++testSocketsD :: Assertion+testSocketsD = do+  (a,b) <- demand =<< S.socketPair 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++sample :: ByteArray+sample = E.fromList [1,2,3,4,5]++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"+