packages feed

posix-api 0.1.0.0 → 0.2.0.0

raw patch · 9 files changed

+687/−175 lines, 9 files

Files

CHANGELOG.md view
@@ -1,5 +1,13 @@-# Revision history for posix+# Changelog+All notable changes to this project will be documented in this file. -## 0.1.0.0 -- YYYY-mm-dd+The format is inspired by [Keep a Changelog](http://keepachangelog.com/en/1.0.0/).+This changelog deviates from the recommendation by not grouping changes into+added, changed, deprecated, etc. subsections. -* First version. Released on an unsuspecting world.+This project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/).++## [0.1.0.0] - 2018-01-02+- Initial release.+- Includes a ton of sockets API stuff.+- Includes the get working directory function.
+ README.md view
@@ -0,0 +1,60 @@+# posix-api++## Objective++This library provides minimal bindings to system calls for POSIX-compliant+operating systems. All functions follow these design decisions:++* `String` is not used anywhere. `ByteArray` (from `primitive`) is used for+  serialized data. It is also used in certain filesystem function variants+  used in contexts where the paths are only ever handed over to other+  filesystem functions. `Addr` (from `primitive`) is used for pointers to+  data whose type is unknown. `Ptr` is used for pointers to data whose type+  is known.+* Functions should not throw errors. This library uses `IO (Either Errno a)`+  in places where some libraries 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.+* There is some platform-specific code in this library. POSIX-specified data+  structures do not have the same in-memory representation on all platforms.+  Consequently, some of the code to serialize data to its C-struct+  representation must be written differently on different platforms.+  This is seldom needed. A viable alternative would be using the FFI+  to perform this serialization. However, the approach of using+  per-platform haskell code lets the serialization code inline better.++Pull requests that add bindings to POSIX APIs in a way that agrees+with these guidelines will be accepted. Unfortunately, there is some+grey area when it comes to what a "minimal binding" to a function+is. Discussion may sometimes be necessary to refine the guidelines.++## Build Instructions++This library relies on a currently-unreleased version of `hsc2hs` in+order to build. In order to try out this library, try:++```+~/dev $ git clone https://github.com/haskell/hsc2hs+~/dev $ cd hsc2hs+~/dev/hsc2hs $ cabal install+~/dev/hsc2hs $ cd ..+~/dev $ git clone https://github.com/andrewthad/posix-api+~/dev $ cd posix-api+~/dev/posix-api $ cabal new-build --with-hsc2hs=~/.cabal/bin/hsc2hs+```++This will build `posix-api` with the unreleased version of the `hsc2hs`+tool.++## Infelicities++This project currently includes some Linux-specific code. It in the+the `Linux.Socket`. The plan is to eventually move the `Linux.Socket` module+into its own library. Currently, a ton of POSIX APIs are missing.+These should be included.+
+ include/custom.h view
@@ -0,0 +1,87 @@+#include <stddef.h>++// This include file lets us use hsc2hs to generate code working+// with ByteArray (through Data.Primitive) instead of Ptr.++// The macro FIELD_SIZEOF is defined in the linux kernel.+// It is written out here for portability.+#define INTERNAL_FIELD_SIZEOF(t, f) (sizeof(((t*)0)->f))++// This is a lot like peek except that it is designed to+// work with MutableByteArray instead of Ptr. GHC requires that all+// indexing into ByteArrays is aligned. So, we do some trickery+// based on the size of what the user is requesting.+#define hsc_read(t, f) \+  switch (INTERNAL_FIELD_SIZEOF(t,f)) { \+    case 1: \+      hsc_printf ("(\\hsc_arr -> readByteArray hsc_arr %ld)", (long) offsetof (t, f)); \+      break; \+    case 2: \+      if (offsetof (t, f) % 2 == 0) \+        hsc_printf ("(\\hsc_arr -> readByteArray hsc_arr %ld)", ((long) offsetof (t, f)) / 2); \+      else \+        hsc_printf ("BAD_READ_ALIGNMENT"); \+      break; \+    default: \+      hsc_printf ("(BAD_READ_SIZE_%ld)", (long) INTERNAL_FIELD_SIZEOF(t,f)); \+      break; \+  }++// This is like peek except that it is designed to work with ByteArray+// instead of Ptr. See hsc_read. This function becomes indexByteArray.+#define hsc_index(t, f) \+  switch (INTERNAL_FIELD_SIZEOF(t,f)) { \+    case 1: \+      hsc_printf ("(\\hsc_arr -> indexByteArray hsc_arr %ld)", (long) offsetof (t, f)); \+      break; \+    case 2: \+      if (offsetof (t, f) % 2 == 0) \+        hsc_printf ("(\\hsc_arr -> indexByteArray hsc_arr %ld)", ((long) offsetof (t, f)) / 2); \+      else \+        hsc_printf ("BAD_INDEX_ALIGNMENT"); \+      break; \+    case 4: \+      if (offsetof (t, f) % 4 == 0) \+        hsc_printf ("(\\hsc_arr -> indexByteArray hsc_arr %ld)", ((long) offsetof (t, f)) / 4); \+      else \+        hsc_printf ("BAD_INDEX_ALIGNMENT"); \+      break; \+    default: \+      hsc_printf ("(BAD_INDEX_SIZE_%ld)", (long) INTERNAL_FIELD_SIZEOF(t,f)); \+      break; \+  }++// This is a lot like poke except that it is designed to+// work with MutableByteArray instead of Ptr. See hsc_read.+#define hsc_write(t, f) \+  switch (INTERNAL_FIELD_SIZEOF(t,f)) { \+    case 1: \+      hsc_printf ("(\\hsc_arr -> writeByteArray hsc_arr %ld)", (long) offsetof (t, f)); \+      break; \+    case 2: \+      if (offsetof (t, f) % 2 == 0) \+        hsc_printf ("(\\hsc_arr -> writeByteArray hsc_arr %ld)", ((long) offsetof (t, f)) / 2); \+      else \+        hsc_printf ("BAD_WRITE_ALIGNMENT"); \+      break; \+    case 4: \+      if (offsetof (t, f) % 4 == 0) \+        hsc_printf ("(\\hsc_arr -> writeByteArray hsc_arr %ld)", ((long) offsetof (t, f)) / 4); \+      else \+        hsc_printf ("BAD_WRITE_ALIGNMENT"); \+      break; \+    default: \+      hsc_printf ("(BAD_WRITE_SIZE_%ld)", (long) INTERNAL_FIELD_SIZEOF(t,f)); \+      break; \+  }++// Compute an element offset from a byte offset and the element size.+// This causes a compile-time failure if the element size does not+// divide evenly into the byte offset. This is commonly used as:+#define hsc_elementize(boff, sz) \+  if ((boff) % (sz) == 0) { \+    hsc_printf ("%ld", ((boff) / (sz))); \+  } else { \+    hsc_printf ("BAD_ELEMENT_OFFSET"); \+  }+
posix-api.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: posix-api-version: 0.1.0.0+version: 0.2.0.0 synopsis: posix bindings description:   This library provides a very thin wrapper around POSIX APIs. It can be@@ -65,9 +65,11 @@ category: System build-type: Simple extra-source-files:+  README.md   CHANGELOG.md   cbits/HaskellPosix.c   include/HaskellPosix.h+  include/custom.h  library   exposed-modules:
src-linux/Posix/Socket/Platform.hsc view
@@ -12,6 +12,7 @@ #include <netinet/in.h> #include <netinet/ip.h> #include <arpa/inet.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.@@ -19,48 +20,64 @@   ( -- * Encoding Socket Addresses     encodeSocketAddressInternet   , encodeSocketAddressUnix+    -- * Decoding Socket Addresses+  , decodeSocketAddressInternet+    -- * Sizes+  , sizeofSocketAddressInternet   ) where -import Data.Primitive (ByteArray(..),Addr(..))-import Data.Void (Void)+import Control.Monad (when)+import Data.Primitive (ByteArray(..),writeByteArray,indexByteArray) 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 Foreign.C.Types (CUShort,CInt)+import GHC.Exts (ByteArray##,State##,RealWorld,runRW##)+import GHC.ST (ST(..)) import Posix.Socket.Types (SocketAddress(..))-import Control.Monad (when)+import Posix.Socket.Types (SocketAddressInternet(..),SocketAddressUnix(..))  import qualified Data.Primitive as PM import qualified Foreign.Storable as FS +-- | The size of a serialized internet socket address.  +sizeofSocketAddressInternet :: CInt+sizeofSocketAddressInternet = #{size struct sockaddr_in}+ -- | 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}+  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)-    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)+    #{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.-    #{poke struct sockaddr_in, sin_port} ptr port-    #{poke struct sockaddr_in, sin_addr.s_addr} ptr address+    #{write struct sockaddr_in, sin_port} bs port+    #{write struct sockaddr_in, sin_addr.s_addr} bs address     r <- PM.unsafeFreezeByteArray bs-    touchByteArray r     pure r +decodeSocketAddressInternet :: SocketAddress -> Maybe SocketAddressInternet+decodeSocketAddressInternet (SocketAddress arr) =+  if PM.sizeofByteArray arr == (#{size struct sockaddr_in})+    -- We assume that AF_INET takes up 16 bits. See the comment in+    -- encodeSocketAddressInternet for more detail.+    then if (#{index struct sockaddr_in, sin_family} arr) == (#{const AF_INET} :: CUShort)+      then Just $ SocketAddressInternet+        { port = #{index struct sockaddr_in, sin_port} arr+        , address = #{index struct sockaddr_in, sin_addr.s_addr} arr+        }+      else Nothing+    else Nothing+ -- | 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@@ -69,7 +86,7 @@ --   error code. encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress encodeSocketAddressUnix (SocketAddressUnix !name) =-  SocketAddress $ runByteArrayIO $ unboxByteArrayIO $ do +  SocketAddress $ runByteArrayST $ unboxByteArrayST $ 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.@@ -77,7 +94,7 @@     -- 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)+    bs <- PM.newByteArray (pathSize + familySize)     PM.setByteArray bs familySize pathSize (0 :: Word8)     PM.writeByteArray bs 0 (#{const AF_UNIX} :: CUShort)     let sz = PM.sizeofByteArray name@@ -85,18 +102,12 @@       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+unboxByteArrayST :: ST s ByteArray -> State## s -> (## State## s, ByteArray## ##)+unboxByteArrayST (ST 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+-- This is a specialization of runST that avoids a needless+-- data constructor allocation.+runByteArrayST :: (State## RealWorld -> (## State## RealWorld, ByteArray## ##)) -> ByteArray+runByteArrayST st_rep = case runRW## st_rep of (## _, a ##) -> ByteArray a
src/Linux/Socket.hs view
@@ -1,6 +1,35 @@ module Linux.Socket-  ( -- * Flags-    LST.dontWait+  ( -- * Types+    SocketFlags(..)+    -- * Message Flags+  , LST.dontWait+  , LST.truncate+    -- * Socket Flags+  , LST.closeOnExec+  , LST.nonblocking+    -- * Twiddle+  , applySocketFlags   ) where +import Prelude hiding (truncate)++import Data.Bits ((.|.))+import Linux.Socket.Types (SocketFlags(..))+import Posix.Socket (Type(..))+ import qualified Linux.Socket.Types as LST++-- | 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:+--+--   > uninterruptibleSocket internet (applySocketFlags closeOnExec stream) defaultProtocol+--+--   To additionally open the socket in nonblocking mode+--   (e.g. with @SOCK_NONBLOCK@):+--+--   > uninterruptibleSocket internet (applySocketFlags (closeOnExec <> nonblocking) stream) defaultProtocol+--   +applySocketFlags :: SocketFlags -> Type -> Type+applySocketFlags (SocketFlags s) (Type t) = Type (s .|. t)
src/Linux/Socket/Types.hsc view
@@ -1,14 +1,44 @@+{-# language DerivingStrategies #-}+{-# language GeneralizedNewtypeDeriving #-}+ #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+  ( SocketFlags(..)+  , dontWait+  , truncate+  , closeOnExec+  , nonblocking   ) where -import Posix.Socket (Flags(..))+import Prelude hiding (truncate) +import Data.Bits (Bits((.|.)))+import Foreign.C.Types (CInt)+import Posix.Socket (MessageFlags(..))++newtype SocketFlags = SocketFlags CInt+  deriving stock (Eq)+  deriving newtype (Bits)++instance Semigroup SocketFlags where (<>) = (.|.)+instance Monoid SocketFlags where mempty = SocketFlags 0+ -- | The @MSG_DONTWAIT@ receive flag or send flag.-dontWait :: Flags m-dontWait = Flags #{const MSG_DONTWAIT}+dontWait :: MessageFlags m+dontWait = MessageFlags #{const MSG_DONTWAIT}++-- | The @MSG_TRUNC@ receive flag.+truncate :: MessageFlags m+truncate = MessageFlags #{const MSG_DONTWAIT}++-- | The @SOCK_CLOEXEC@ receive flag or send flag.+closeOnExec :: SocketFlags+closeOnExec = SocketFlags #{const SOCK_CLOEXEC}++-- | The @SOCK_NONBLOCK@ receive flag or send flag.+nonblocking :: SocketFlags+nonblocking = SocketFlags #{const SOCK_NONBLOCK}
src/Posix/Socket.hs view
@@ -1,6 +1,5 @@ {-# language BangPatterns #-} {-# language DataKinds #-}-{-# language InterruptibleFFI #-} {-# language MagicHash #-} {-# language ScopedTypeVariables #-} {-# language UnboxedTuples #-}@@ -18,47 +17,70 @@ --     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.+--   * There are no requirements on the pinnedness of @ByteArray@ arguments+--     passed to any of these functions. If wrappers of the safe FFI are+--     passed unpinned @ByteArray@ arguments, they will copy the contents+--     into pinned memory before invoking the foreign function. module Posix.Socket   ( -- * Functions     -- ** Socket-    socket+    uninterruptibleSocket     -- ** Socket Pair-  , socketPair+  , uninterruptibleSocketPair     -- ** Bind-  , bind+  , uninterruptibleBind     -- ** Connect   , connect+  , uninterruptibleConnect     -- ** Listen-  , listen+  , uninterruptibleListen     -- ** Accept   , accept+  , uninterruptibleAccept   , accept_+    -- ** Get Socket Name+  , uninterruptibleGetSocketName+    -- ** Get Socket Option+  , uninterruptibleGetSocketOption     -- ** Close   , close-  , unsafeClose+  , uninterruptibleClose+  , uninterruptibleErrorlessClose+    -- ** Shutdown+  , uninterruptibleShutdown     -- ** Send   , send   , sendByteArray   , sendMutableByteArray-  , unsafeSend-  , unsafeSendByteArray-  , unsafeSendMutableByteArray+  , uninterruptibleSend+  , uninterruptibleSendByteArray+  , uninterruptibleSendMutableByteArray     -- ** Send To-  , unsafeSendToByteArray-  , unsafeSendToMutableByteArray+  , uninterruptibleSendToByteArray+  , uninterruptibleSendToMutableByteArray     -- ** Receive   , receive   , receiveByteArray-  , unsafeReceive-  , unsafeReceiveMutableByteArray+  , uninterruptibleReceive+  , uninterruptibleReceiveMutableByteArray     -- ** Receive From-  , unsafeReceiveFromMutableByteArray-  , unsafeReceiveFromMutableByteArray_+  , uninterruptibleReceiveFromMutableByteArray+  , uninterruptibleReceiveFromMutableByteArray_+    -- ** Byte-Order Conversion+    -- $conversion+  , hostToNetworkLong+  , hostToNetworkShort+  , networkToHostLong+  , networkToHostShort     -- * Types   , Domain(..)   , Type(..)   , Protocol(..)-  , Flags(..)+  , OptionName(..)+  , OptionValue(..)+  , Level(..)+  , MessageFlags(..)+  , ShutdownType(..)     -- * Socket Address     -- ** Types   , SocketAddress(..)@@ -67,11 +89,16 @@     -- ** Encoding   , PSP.encodeSocketAddressInternet   , PSP.encodeSocketAddressUnix+    -- ** Decoding+  , PSP.decodeSocketAddressInternet+    -- ** Sizes+  , PSP.sizeofSocketAddressInternet     -- * Data Construction     -- ** Socket Domains   , PST.unix   , PST.unspecified   , PST.internet+  , PST.internet6     -- ** Socket Types   , PST.stream   , PST.datagram@@ -89,21 +116,34 @@   , PST.peek   , PST.outOfBand   , PST.waitAll+    -- ** Shutdown Types+  , PST.read+  , PST.write+  , PST.readWrite+    -- ** Socket Levels+  , PST.levelSocket+    -- ** Option Names+  , PST.optionError   ) where +import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder) import GHC.IO (IO(..)) import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),Addr(..),ByteArray(..))+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#)+import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#,Addr#,Int(I#))+import GHC.Exts (shrinkMutableByteArray#) import Posix.Socket.Types (Domain(..),Protocol(..),Type(..),SocketAddress(..))-import Posix.Socket.Types (Flags(..),Message(..))+import Posix.Socket.Types (MessageFlags(..),Message(..),ShutdownType(..))+import Posix.Socket.Types (Level(..),OptionName(..),OptionValue(..)) import System.Posix.Types (Fd(..),CSsize(..))  import qualified Posix.Socket.Types as PST import qualified Data.Primitive as PM+import qualified Control.Monad.Primitive as PM  -- This module include operating-system specific code used -- to serialize some of various kind of socket address types.@@ -118,12 +158,15 @@ foreign import ccall unsafe "sys/socket.h listen"   c_listen :: Fd -> CInt -> IO CInt -foreign import ccall interruptible "unistd.h close"+foreign import ccall safe "unistd.h close"   c_safe_close :: Fd -> IO CInt  foreign import ccall unsafe "unistd.h close"   c_unsafe_close :: Fd -> IO CInt +foreign import ccall unsafe "unistd.h shutdown"+  c_unsafe_shutdown :: Fd -> ShutdownType -> 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@@ -141,19 +184,44 @@ -- 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"+foreign import ccall safe "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"+foreign import ccall unsafe "sys/socket.h accept"+  c_unsafe_accept :: Fd+                  -> MutableByteArray# RealWorld -- SocketAddress+                  -> MutableByteArray# RealWorld -- Ptr CInt+                  -> IO Fd+-- This variant of accept is used when we do not care about the+-- remote sockaddr. We pass null.+foreign import ccall safe "sys/socket.h accept"   c_safe_ptr_accept :: Fd -> Ptr Void -> Ptr CInt -> IO Fd +foreign import ccall unsafe "sys/socket.h getsockname"+  c_unsafe_getsockname :: Fd+                       -> MutableByteArray# RealWorld -- SocketAddress+                       -> MutableByteArray# RealWorld -- Addr length (Ptr CInt)+                       -> IO CInt++foreign import ccall unsafe "sys/socket.h getsockopt"+  c_unsafe_getsockopt :: Fd+                      -> Level+                      -> OptionName+                      -> MutableByteArray# RealWorld -- Option value+                      -> MutableByteArray# RealWorld -- Option len (Ptr CInt)+                      -> 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.-foreign import ccall interruptible "sys/socket.h connect"+foreign import ccall safe "sys/socket.h connect"   c_safe_connect :: Fd -> ByteArray# -> CInt -> IO CInt+foreign import ccall safe "sys/socket.h connect"+  c_safe_mutablebytearray_connect :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CInt+foreign import ccall unsafe "sys/socket.h connect"+  c_unsafe_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@@ -162,65 +230,67 @@ -- 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 safe "sys/socket.h send"+  c_safe_addr_send :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize+foreign import ccall safe "sys/socket.h send_offset"+  c_safe_bytearray_send :: Fd -> ByteArray# -> CInt -> CSize -> MessageFlags 'Send -> IO CSsize+foreign import ccall safe "sys/socket.h send_offset"+  c_safe_mutablebytearray_send :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags 'Send -> IO CSsize+foreign import ccall safe "sys/socket.h send"+  c_safe_mutablebytearray_no_offset_send :: Fd -> MutableByteArray# RealWorld -> CSize -> MessageFlags 'Send -> IO CSsize foreign import ccall unsafe "sys/socket.h send"-  c_unsafe_addr_send :: Fd -> Addr# -> CSize -> Flags 'Send -> IO CSsize+  c_unsafe_addr_send :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize foreign import ccall unsafe "sys/socket.h send_offset"-  c_unsafe_bytearray_send :: Fd -> ByteArray# -> CInt -> CSize -> Flags 'Send -> IO CSsize+  c_unsafe_bytearray_send :: Fd -> ByteArray# -> CInt -> CSize -> MessageFlags '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+  c_unsafe_mutable_bytearray_send :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags '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+  c_unsafe_bytearray_sendto :: Fd -> ByteArray# -> CInt -> CSize -> MessageFlags '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+  c_unsafe_mutable_bytearray_sendto :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags '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 safe "sys/socket.h recv"+  c_safe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize foreign import ccall unsafe "sys/socket.h recv"-  c_unsafe_addr_recv :: Fd -> Addr# -> CSize -> Flags 'Receive -> IO CSsize+  c_unsafe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags '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+  c_unsafe_mutable_byte_array_recv :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags '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+  c_unsafe_mutable_byte_array_recvfrom :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags '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+  c_unsafe_mutable_byte_array_ptr_recvfrom :: Fd -> MutableByteArray# RealWorld -> CInt -> CSize -> MessageFlags '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 ::+--   includes more details. No special preparation is required before calling+--   this function. The author believes that it cannot block for a prolonged+--   period of time.+uninterruptibleSocket ::      Domain -- ^ Communications domain (e.g. 'internet', 'unix')-  -> Type -- ^ Socket type (e.g. 'datagram', 'stream')+  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags   -> Protocol -- ^ Protocol   -> IO (Either Errno Fd)-socket dom typ prot = c_socket dom typ prot >>= errorsFromFd+uninterruptibleSocket 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 ::+--   includes more details. No special preparation is required before calling+--   this function. The author believes that it cannot block for a prolonged+--   period of time.+uninterruptibleSocketPair ::      Domain -- ^ Communications domain (probably 'unix')-  -> Type -- ^ Socket type (e.g. 'datagram', 'stream')+  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags   -> Protocol -- ^ Protocol   -> IO (Either Errno (Fd,Fd))-socketPair dom typ prot = do+uninterruptibleSocketPair 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@@ -237,38 +307,55 @@ --   <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 ::+--   be used with @sockaddr@ extensions on various platforms. No special+--   preparation is required before calling this function. The author+--   believes that it cannot block for a prolonged period of time.+uninterruptibleBind ::      Fd -- ^ Socket   -> SocketAddress -- ^ Socket address, extensible tagged union   -> IO (Either Errno ())-bind fd (SocketAddress b@(ByteArray b#)) =+uninterruptibleBind 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 ::+--   includes more details. No special preparation is required before+--   calling this function. The author believes that it cannot block+--   for a prolonged period of time.+uninterruptibleListen ::      Fd -- ^ Socket   -> CInt -- ^ Backlog   -> IO (Either Errno ())-listen fd backlog = c_listen fd backlog >>= errorsFromInt+uninterruptibleListen 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.+--   includes more details. 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+  case PM.isByteArrayPinned sockAddr of+    True -> c_safe_connect fd sockAddr# (intToCInt (PM.sizeofByteArray sockAddr)) >>= errorsFromInt+    False -> do+      let len = PM.sizeofByteArray sockAddr+      x@(MutableByteArray x#) <- PM.newPinnedByteArray len+      PM.copyByteArray x 0 sockAddr 0 len+      c_safe_mutablebytearray_connect fd x# (intToCInt len) >>= errorsFromInt +-- | Connect the socket to the specified socket address.+--   The <http://pubs.opengroup.org/onlinepubs/9699919799/functions/connect.html POSIX specification>+--   includes more details. The only sensible way to use this is to+--   give a nonblocking socket as the argument.+uninterruptibleConnect ::+     Fd -- ^ Fd+  -> SocketAddress -- ^ Socket address, extensible tagged union+  -> IO (Either Errno ())+uninterruptibleConnect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =+  c_unsafe_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@@ -297,8 +384,8 @@ accept ::      Fd -- ^ Listening socket   -> CInt -- ^ Maximum socket address size-  -> IO (Either Errno (SocketAddress,Fd)) -- ^ Peer information and connected socket-accept sock maxSz = do+  -> IO (Either Errno (CInt,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@@ -306,10 +393,38 @@   if r > (-1)     then do       (sz :: CInt) <- PM.readByteArray lenBuf 0-      sockAddr <- PM.unsafeFreezeByteArray =<< PM.resizeMutableByteArray sockAddrBuf (cintToInt sz)-      pure (Right (SocketAddress sockAddr,r))+      -- Why copy when we could just shrink? We want to always return+      -- byte arrays that are not explicitly pinned.+      let minSz = min sz maxSz+      x <- PM.newByteArray (cintToInt minSz)+      PM.copyMutableByteArray x 0 sockAddrBuf 0 (cintToInt minSz)+      sockAddr <- PM.unsafeFreezeByteArray x+      -- sockAddr <- PM.unsafeFreezeByteArray =<< PM.resizeMutableByteArray sockAddrBuf (cintToInt sz)+      pure (Right (sz,SocketAddress sockAddr,r))     else fmap Left getErrno +-- | See 'accept'. This uses the unsafe FFI. Consequently, it does not+--   not need to allocate pinned memory. It only makes sense to call this+--   on a nonblocking socket.+uninterruptibleAccept ::+     Fd -- ^ Listening socket+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (CInt,SocketAddress,Fd)) -- ^ Peer information and connected socket+uninterruptibleAccept !sock !maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_unsafe_accept sock sockAddrBuf# lenBuf#+  if r > (-1)+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      if sz < maxSz+        then shrinkMutableByteArray sockAddrBuf (cintToInt sz)+        else pure ()+      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf+      pure (Right (sz,SocketAddress sockAddr,r))+    else fmap Left getErrno+ -- | A variant of 'accept' that does not provide the user with a --   'SocketAddress' detailing the peer. accept_ ::@@ -318,9 +433,57 @@ accept_ sock =   c_safe_ptr_accept sock nullPtr nullPtr >>= errorsFromFd +-- | Retrieve the locally-bound name of the specified socket. The+--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>+--   of @getsockname@ includes more details.+uninterruptibleGetSocketName ::+     Fd -- ^ Socket+  -> CInt -- ^ Maximum socket address size+  -> IO (Either Errno (CInt,SocketAddress))+uninterruptibleGetSocketName sock maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_unsafe_getsockname sock sockAddrBuf# lenBuf#+  if r == 0+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      if sz < maxSz+        then shrinkMutableByteArray sockAddrBuf (cintToInt sz)+        else pure ()+      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf+      pure (Right (sz,SocketAddress sockAddr))+    else fmap Left getErrno++-- | Retrieve 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.+uninterruptibleGetSocketOption ::+     Fd -- ^ Socket+  -> Level -- ^ Socket level+  -> OptionName -- Option name+  -> CInt -- ^ Maximum option value size+  -> IO (Either Errno (CInt,OptionValue))+uninterruptibleGetSocketOption sock level optName maxSz = do+  valueBuf@(MutableByteArray valueBuf#) <- PM.newByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_unsafe_getsockopt sock level optName valueBuf# lenBuf#+  if r == 0+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      if sz < maxSz+        then shrinkMutableByteArray valueBuf (cintToInt sz)+        else pure ()+      value <- PM.unsafeFreezeByteArray valueBuf+      pure (Right (sz,OptionValue value))+    else fmap Left getErrno++ -- | 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+--   actually present in the array. Since this uses the safe --   FFI, it allocates a pinned copy of the bytearry if it was not --   already pinned. sendByteArray ::@@ -328,7 +491,7 @@   -> ByteArray -- ^ Source byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags '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@@ -339,7 +502,7 @@  -- | 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+--   actually present in the array. Since this uses the safe --   FFI, it allocates a pinned copy of the bytearry if it was not --   already pinned. sendMutableByteArray ::@@ -347,7 +510,7 @@   -> MutableByteArray RealWorld -- ^ Source byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags '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@@ -357,13 +520,13 @@     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+--   to send the entire length. This uses the safe FFI since --   it may block indefinitely. send ::      Fd -- ^ Connected socket   -> Addr -- ^ Source address   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags '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@@ -373,41 +536,41 @@ --   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 ::+uninterruptibleSend ::      Fd -- ^ Socket   -> Addr -- ^ Source address   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags 'Send -- ^ Flags   -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-unsafeSend fd (Addr addr) len flags =+uninterruptibleSend 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 ::+uninterruptibleSendByteArray ::      Fd -- ^ Socket   -> ByteArray -- ^ Source byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags 'Send -- ^ Flags   -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-unsafeSendByteArray fd (ByteArray b) off len flags =+uninterruptibleSendByteArray 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 ::+uninterruptibleSendMutableByteArray ::      Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Source mutable byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags 'Send -- ^ Flags   -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-unsafeSendMutableByteArray fd (MutableByteArray b) off len flags =+uninterruptibleSendMutableByteArray 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.@@ -415,15 +578,15 @@ --   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 :: +uninterruptibleSendToByteArray ::       Fd -- ^ Socket   -> ByteArray -- ^ Source byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags '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#)) =+uninterruptibleSendToByteArray 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.@@ -431,38 +594,38 @@ --   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 :: +uninterruptibleSendToMutableByteArray ::       Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Source byte array   -> CInt -- ^ Offset into source array   -> CSize -- ^ Length in bytes-  -> Flags 'Send -- ^ Flags+  -> MessageFlags '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#)) =+uninterruptibleSendToMutableByteArray 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+--   the safe 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+  -> MessageFlags '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+--   the safe 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+  -> MessageFlags 'Receive -- ^ Flags   -> IO (Either Errno ByteArray)-receiveByteArray fd len flags = do+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@@ -483,66 +646,75 @@ --   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 ::+uninterruptibleReceive ::      Fd -- ^ Socket   -> Addr -- ^ Source address   -> CSize -- ^ Length in bytes-  -> Flags 'Receive -- ^ Flags+  -> MessageFlags 'Receive -- ^ Flags   -> IO (Either Errno CSize)-unsafeReceive fd (Addr addr) len flags =+uninterruptibleReceive !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 ::+uninterruptibleReceiveMutableByteArray ::      Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Destination byte array   -> CInt -- ^ Destination offset   -> CSize -- ^ Maximum bytes to receive-  -> Flags 'Receive -- ^ Flags+  -> MessageFlags 'Receive -- ^ Flags   -> IO (Either Errno CSize) -- ^ Bytes received into array-unsafeReceiveMutableByteArray fd (MutableByteArray b) off len flags =+uninterruptibleReceiveMutableByteArray !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 ::+-- | 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. This function does not resize the buffer.+uninterruptibleReceiveFromMutableByteArray ::      Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Destination byte array   -> CInt -- ^ Destination offset   -> CSize -- ^ Maximum bytes to receive-  -> Flags 'Receive -- ^ Flags+  -> MessageFlags '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))+  -> IO (Either Errno (CInt,SocketAddress,CSize))+     -- ^ Remote host, bytes received into array, bytes needed for @addrlen@.+{-# INLINE uninterruptibleReceiveFromMutableByteArray #-}+-- GHC does not inline this unless we give it the pragma. We really+-- want this to inline since inlining typically avoids the Left/Right+-- data constructor allocation.+uninterruptibleReceiveFromMutableByteArray !fd (MutableByteArray !b) !off !len !flags !maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newByteArray (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))+      if sz < maxSz+        then shrinkMutableByteArray sockAddrBuf (cintToInt sz)+        else pure ()+      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf+      pure (Right (sz,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_ ::+uninterruptibleReceiveFromMutableByteArray_ ::      Fd -- ^ Socket   -> MutableByteArray RealWorld -- ^ Destination byte array   -> CInt -- ^ Destination offset   -> CSize -- ^ Maximum bytes to receive-  -> Flags 'Receive -- ^ Flags+  -> MessageFlags 'Receive -- ^ Flags   -> IO (Either Errno CSize) -- ^ Number of bytes received into array-unsafeReceiveFromMutableByteArray_ fd (MutableByteArray b) off len flags =+uninterruptibleReceiveFromMutableByteArray_ !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.+--   includes more details. This uses the safe FFI. close ::      Fd -- ^ Socket   -> IO (Either Errno ())@@ -555,11 +727,32 @@ --   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 ::+uninterruptibleClose ::      Fd -- ^ Socket   -> IO (Either Errno ())-unsafeClose fd = c_unsafe_close fd >>= errorsFromInt+uninterruptibleClose fd = c_unsafe_close fd >>= errorsFromInt +-- | Close a socket with the unsafe FFI. Do not check for errors. It is only+--   appropriate to use this when a socket is being closed to handle an+--   exceptional case. Since the user will want the propogate the original+--   exception, the exception provided by 'uninterruptibleClose' would just+--   be discarded. This function allows us to potentially avoid an additional+--   FFI call to 'getErrno'.+uninterruptibleErrorlessClose ::+     Fd -- ^ Socket+  -> IO ()+uninterruptibleErrorlessClose fd = do+  _ <- c_unsafe_close fd+  pure ()++-- | Shutdown a socket. This uses the unsafe FFI.+uninterruptibleShutdown ::+     Fd+  -> ShutdownType+  -> IO (Either Errno ())+uninterruptibleShutdown fd typ =+  c_unsafe_shutdown fd typ >>= errorsFromInt+ errorsFromSize :: CSsize -> IO (Either Errno CSize) errorsFromSize r = if r > (-1)   then pure (Right (cssizeToCSize r))@@ -599,4 +792,40 @@ --  -- 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)++-- | Convert a 16-bit word from host to network byte order (e.g. @htons@).+hostToNetworkShort :: Word16 -> Word16+hostToNetworkShort = case targetByteOrder of+  BigEndian -> id+  LittleEndian -> byteSwap16++-- | Convert a 16-bit word from network to host byte order (e.g. @ntohs@).+networkToHostShort :: Word16 -> Word16+networkToHostShort = case targetByteOrder of+  BigEndian -> id+  LittleEndian -> byteSwap16++-- | Convert a 32-bit word from host to network byte order (e.g. @htonl@).+hostToNetworkLong :: Word32 -> Word32+hostToNetworkLong = case targetByteOrder of+  BigEndian -> id+  LittleEndian -> byteSwap32++-- | Convert a 32-bit word from network to host byte order (e.g. @ntohl@).+networkToHostLong :: Word32 -> Word32+networkToHostLong = case targetByteOrder of+  BigEndian -> id+  LittleEndian -> byteSwap32++{- $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.+-}
src/Posix/Socket/Types.hsc view
@@ -5,6 +5,10 @@ {-# language GeneralizedNewtypeDeriving #-} {-# language KindSignatures #-} +-- This is needed because hsc2hs does not currently handle ticked+-- promoted data constructors correctly.+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+ #include <sys/socket.h> #include <netinet/in.h> @@ -14,16 +18,21 @@   ( Domain(..)   , Type(..)   , Protocol(..)+  , Level(..)+  , OptionName(..)+  , OptionValue(..)   , SocketAddress(..)   , SocketAddressInternet(..)   , SocketAddressInternet6(..)   , SocketAddressUnix(..)-  , Flags(..)+  , MessageFlags(..)   , Message(..)+  , ShutdownType(..)     -- * Socket Families   , unix   , unspecified   , internet+  , internet6     -- * Socket Types   , stream   , datagram@@ -41,12 +50,23 @@   , peek   , outOfBand   , waitAll+    -- * Shutdown Types+  , read+  , write+  , readWrite+    -- * Socket Levels+  , levelSocket+    -- * Option Names+  , optionError   ) where -import Foreign.C.Types (CInt(..))-import Data.Primitive (ByteArray)+import Prelude hiding (read)+ import Data.Bits (Bits,(.|.))+import Data.Primitive (ByteArray) import Data.Word (Word16,Word32,Word64)+import Foreign.C.Types (CInt(..))+ import qualified Data.Kind  -- | A socket communications domain, sometimes referred to as a family. The spec@@ -60,29 +80,37 @@  newtype Protocol = Protocol CInt +newtype Level = Level CInt++newtype OptionName = OptionName CInt++-- | Which end of the socket to shutdown.+newtype ShutdownType = ShutdownType 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+-- | Receive flags are given by @MessageFlags Receive@ and send flags+--   are given by @MessageFlags 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+newtype MessageFlags :: Message -> Data.Kind.Type where+  MessageFlags :: CInt -> MessageFlags m   deriving stock (Eq)   deriving newtype (Bits) -instance Semigroup (Flags m) where (<>) = (.|.)-instance Monoid (Flags m) where mempty = Flags 0+instance Semigroup (MessageFlags m) where (<>) = (.|.)+instance Monoid (MessageFlags m) where mempty = MessageFlags 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.+-- | 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. newtype SocketAddress = SocketAddress ByteArray +-- | The @option_value@ data.+newtype OptionValue = OptionValue 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:@@ -161,17 +189,25 @@ internet :: Domain internet = Domain #{const AF_INET} +-- | The @AF_INET6@ communications domain. 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.+internet6 :: Domain+internet6 = Domain #{const AF_INET6}+ -- | The @MSG_OOB@ receive flag or send flag.-outOfBand :: Flags m-outOfBand = Flags #{const MSG_OOB}+outOfBand :: MessageFlags m+outOfBand = MessageFlags #{const MSG_OOB}  -- | The @MSG_PEEK@ receive flag.-peek :: Flags 'Receive-peek = Flags #{const MSG_PEEK}+peek :: MessageFlags Receive+peek = MessageFlags #{const MSG_PEEK}  -- | The @MSG_WAITALL@ receive flag.-waitAll :: Flags 'Receive-waitAll = Flags #{const MSG_WAITALL}+waitAll :: MessageFlags Receive+waitAll = MessageFlags #{const MSG_WAITALL}  -- | The default protocol for a socket type. defaultProtocol :: Protocol@@ -200,4 +236,24 @@ -- | The @IPPROTO_IPV6@ protocol. ipv6 :: Protocol ipv6 = Protocol #{const IPPROTO_IPV6}++-- | Disable further receive operations (e.g. @SHUT_RD@)+read :: ShutdownType+read = ShutdownType #{const SHUT_RD}++-- | Disable further send operations (e.g. @SHUT_WR@)+write :: ShutdownType+write = ShutdownType #{const SHUT_WR}++-- | Disable further send operations (e.g. @SHUT_RDWR@)+readWrite :: ShutdownType+readWrite = ShutdownType #{const SHUT_RDWR}++-- | Socket error status (e.g. @SOL_SOCKET@)+levelSocket :: Level+levelSocket = Level #{const SOL_SOCKET}++-- | Socket error status (e.g. @SO_ERROR@)+optionError :: OptionName+optionError = OptionName #{const SO_ERROR}