packages feed

posix-api 0.3.4.0 → 0.3.5.0

raw patch · 15 files changed

+771/−113 lines, 15 filesdep +byte-orderdep +run-st

Dependencies added: byte-order, run-st

Files

CHANGELOG.md view
@@ -7,6 +7,15 @@  This project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). +## [0.3.5.0] - 2020-??-??++- Breaking: Start using pattern synonyms for macros.+- Add dedicated modules for peeking at structures.+- Make compatible with GHC 8.10 by changing the way ArrayArray# is handled+  on the C side of the FFI.+- Add `uninterruptibleSetSocketOption`.+- Add socket options `SO_BINDTODEVICE` and `SO_REUSEADDR`.+ ## [0.3.4.0] - 2020-03-09  - Add `Posix.File`
cbits/HaskellPosix.c view
@@ -26,6 +26,21 @@ // way to support providing an offset (without just copying the bytes // into pinned memory) is to use a wrapper. +ssize_t write_offset_loop(int fd, const char *message, HsInt offset, size_t length){+  ssize_t r;+  size_t bytesSent;+  const char* buf = message + offset;+  while(length > 0){+    if ((r = write(fd, (const void*)buf, length)) == -1) {+      return (-1);+    } else {+      bytesSent = (size_t)r;+      buf = buf + bytesSent;+      length = length - bytesSent;+    }+  }+  return 0;+} ssize_t write_offset(int fd, const char *message, HsInt offset, size_t length){   return write(fd, (const void*)(message + offset), length); }@@ -105,16 +120,24 @@   return setsockopt(socket,level,option_name,&option_value,sizeof(int)); } +// There are some compatibility macros in here. Before GHC 8.10,+// no offset is applied to ArrayArray#. ssize_t sendmsg_bytearrays   ( int sockfd+#if __GLASGOW_HASKELL__ >= 810+  , StgArrBytes **arrs // used for input+#else   , StgMutArrPtrs *arr // used for input+#endif   , HsInt off // offset into input chunk array   , HsInt len0 // number of chunks to send   , HsInt offC // offset into first chunk   , int flags   ) {+#if __GLASGOW_HASKELL__ < 810   StgClosure **arrPayload = arr->payload;   StgArrBytes **arrs = (StgArrBytes**)arrPayload;+#endif   struct iovec bufs[MAX_BYTEARRAYS];   HsInt len1 = len0 > MAX_BYTEARRAYS ? MAX_BYTEARRAYS : len0;   // We must handle the first chunk specially since@@ -194,16 +217,24 @@   return sendmsg(sockfd,&msg,flags); } +// There are some compatibility macros in here. Before GHC 8.10,+// no offset is applied to ArrayArray#. int recvmmsg_sockaddr_in   ( int sockfd   , int *lens // used for output   , struct sockaddr_in *addrs // used for output+#if __GLASGOW_HASKELL__ >= 810+  , StgArrBytes **bufs // used for output+#else   , StgMutArrPtrs *arr // used for output+#endif   , unsigned int vlen   , int flags   ) {+#if __GLASGOW_HASKELL__ < 810   StgClosure **bufsX = arr->payload;   StgArrBytes **bufs = (StgArrBytes**)bufsX;+#endif   // TODO: It's probably better to statically pick   // out a maximum size for these. On the C stack,   // the cost of doing this is basically nothing.@@ -238,12 +269,18 @@ int recvmmsg_sockaddr_discard   ( int sockfd   , int *lens // used for output+#if __GLASGOW_HASKELL__ >= 810+  , StgArrBytes **bufs // used for output+#else   , StgMutArrPtrs *arr // used for output+#endif   , unsigned int vlen   , int flags   ) {+#if __GLASGOW_HASKELL__ < 810   StgClosure **bufsX = arr->payload;   StgArrBytes **bufs = (StgArrBytes**)bufsX;+#endif   struct mmsghdr msgs[vlen];   struct iovec vecs[vlen];   for(unsigned int i = 0; i < vlen; i++) {
include/HaskellPosix.h view
@@ -12,6 +12,21 @@  int setsockopt_int(int socket, int level, int option_name, int option_value); -int recvmmsg_sockaddr_in (int sockfd , int *lens , struct sockaddr_in *addrs , StgMutArrPtrs *arr , unsigned int vlen , int flags);-int recvmmsg_sockaddr_discard (int sockfd , int *lens , StgMutArrPtrs *arr , unsigned int vlen , int flags);+// There are some compatibility macros in here. Before GHC 8.10,+// no offset is applied to ArrayArray#.+int recvmmsg_sockaddr_in (int sockfd , int *lens , struct sockaddr_in *addrs+#if __GLASGOW_HASKELL__ >= 810+  , StgArrBytes **bufs // used for output+#else+  , StgMutArrPtrs *arr // used for output+#endif+  , unsigned int vlen , int flags);++int recvmmsg_sockaddr_discard (int sockfd , int *lens+#if __GLASGOW_HASKELL__ >= 810+  , StgArrBytes **bufs // used for output+#else+  , StgMutArrPtrs *arr // used for output+#endif+  , unsigned int vlen , int flags);
posix-api.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.2 name: posix-api-version: 0.3.4.0+version: 0.3.5.0 synopsis: posix bindings description:   This library provides a very thin wrapper around POSIX APIs. It can be@@ -78,6 +78,7 @@  library   exposed-modules:+    Foreign.C.String.Managed     Linux.Epoll     Linux.MessageQueue     Linux.Socket@@ -89,6 +90,8 @@     Posix.Select     Posix.Socket     Posix.Types+    Posix.Struct.SocketAddressInternet.Peek+    Posix.Struct.AddressInfo.Peek   other-modules:     Linux.Epoll.Types     Linux.MessageQueue.Types@@ -101,11 +104,13 @@     Assertion   build-depends:     , base >=4.11.1 && <5+    , byte-order >= 0.1.2 && <0.2     , byteslice >= 0.1.3 && <0.3     , primitive >= 0.7 && <0.8     , primitive-addr >= 0.1 && <0.2     , primitive-offset >= 0.2 && <0.3     , primitive-unlifted >= 0.1 && <0.2+    , run-st >= 0.1.1 && <0.2   hs-source-dirs: src   if flag(assertions)     hs-source-dirs: src-assertions
+ src/Foreign/C/String/Managed.hs view
@@ -0,0 +1,138 @@+{-# language BangPatterns #-}+{-# language DerivingStrategies #-}+{-# language GeneralizedNewtypeDeriving #-}+{-# language MagicHash #-}+{-# language MultiWayIf #-}+{-# language TypeApplications #-}+{-# language ScopedTypeVariables #-}+{-# language UnboxedTuples #-}++module Foreign.C.String.Managed+  ( ManagedCString(..)+  , terminated+  , terminatedU+  , unterminated+  , fromBytes+  , fromLatinString+  , pinnedFromBytes+  , pin+  , touch+  , contents+  ) where++import Control.Monad.ST (ST)+import Control.Monad.ST.Run (runByteArrayST)+import Data.Bytes.Types (Bytes(Bytes))+import Data.Char (ord)+import Data.Primitive (ByteArray(..),MutableByteArray)+import Data.Word (Word8)+import Foreign.C.String (CString)+import Foreign.Ptr (castPtr)+import GHC.Exts (Int(I#),Char(C#),ByteArray#,chr#,touch#)+import GHC.IO (IO(IO))++import qualified Data.Bytes as Bytes+import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts++-- | An unsliced byte sequence with @NUL@ as the final byte.+newtype ManagedCString = ManagedCString ByteArray+  deriving newtype Eq++instance Semigroup ManagedCString where+  ManagedCString a <> ManagedCString b = ManagedCString $ runByteArrayST $ do+    let lenA = PM.sizeofByteArray a+    let lenB = PM.sizeofByteArray b+    dst <- PM.newByteArray (lenA + lenB - 1)+    PM.copyByteArray dst 0 a 0 (lenA - 1)+    PM.copyByteArray dst (lenA - 1) b 0 lenB+    PM.unsafeFreezeByteArray dst++instance Monoid ManagedCString where+  mempty = ManagedCString $ runByteArrayST $ do+    dst <- PM.newByteArray 1+    PM.writeByteArray dst 0 (0 :: Word8)+    PM.unsafeFreezeByteArray dst++instance Exts.IsString ManagedCString where+  fromString = fromLatinString++instance Show ManagedCString where+  showsPrec _ (ManagedCString arr) s0 = PM.foldrByteArray+    ( \(w :: Word8) s ->+      if | w == 0 -> s+         | w < 32 -> '?' : s+         | w > 126 -> '?' : s+         | otherwise -> case fromIntegral @Word8 @Int w of+             I# i -> C# (chr# i) : s+    ) s0 arr++terminatedU :: ManagedCString -> ByteArray+terminatedU (ManagedCString x) = x++terminated :: ManagedCString -> Bytes+terminated (ManagedCString x) = Bytes.fromByteArray x++unterminated :: ManagedCString -> Bytes+unterminated (ManagedCString x) = Bytes x 0 (PM.sizeofByteArray x - 1)++-- | Copies the slice, appending a @NUL@ byte to the end.+fromBytes :: Bytes -> ManagedCString+fromBytes (Bytes arr off len) = ManagedCString $ runByteArrayST $ do+  dst <- PM.newByteArray (len + 1)+  PM.copyByteArray dst 0 arr off len+  PM.writeByteArray dst len (0 :: Word8)+  PM.unsafeFreezeByteArray dst++-- | Copies the slice into pinned memory, appending a @NUL@ byte to the end.+pinnedFromBytes :: Bytes -> ManagedCString+pinnedFromBytes (Bytes arr off len) = ManagedCString $ runByteArrayST $ do+  dst <- PM.newPinnedByteArray (len + 1)+  PM.copyByteArray dst 0 arr off len+  PM.writeByteArray dst len (0 :: Word8)+  PM.unsafeFreezeByteArray dst++pin :: ManagedCString -> ManagedCString+pin (ManagedCString x) = if PM.isByteArrayPinned x+  then ManagedCString x+  else ManagedCString $ runByteArrayST $ do+    let len = PM.sizeofByteArray x+    dst <- PM.newPinnedByteArray len+    PM.copyByteArray dst 0 x 0 len+    PM.unsafeFreezeByteArray dst++touch :: ManagedCString -> IO ()+touch (ManagedCString (ByteArray x)) = touchByteArray# x++touchByteArray# :: ByteArray# -> IO ()+touchByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)++-- | Convert a 'String' consisting of only characters representable+-- by ISO-8859-1. These are encoded with ISO-8859-1. Any character+-- with a codepoint above @U+00FF@ is replaced by an unspecified byte.+fromLatinString :: String -> ManagedCString+{-# noinline fromLatinString #-}+fromLatinString str = ManagedCString $ runByteArrayST $ do+  let lenPred0 = 63+  dst0 <- PM.newByteArray (lenPred0 + 1)+  go str dst0 0 lenPred0+  where+  go :: forall s. String -> MutableByteArray s -> Int -> Int -> ST s ByteArray+  go [] !dst !ix !_ = do+    PM.writeByteArray dst ix (0 :: Word8)+    PM.resizeMutableByteArray dst (ix + 1) >>= PM.unsafeFreezeByteArray+  go (c:cs) !dst !ix !lenPred = if ix < lenPred+    then do+      PM.writeByteArray dst ix (fromIntegral @Int @Word8 (ord c))+      go cs dst (ix + 1) lenPred+    else do+      let nextLenPred = lenPred * 2+      dst' <- PM.newByteArray (nextLenPred + 1)+      PM.copyMutableByteArray dst' 0 dst 0 ix+      PM.writeByteArray dst' ix (fromIntegral @Int @Word8 (ord c))+      go cs dst' (ix + 1) nextLenPred++-- | Get a pointer to the payload of the managed C string. The behavior is+-- undefined if the argument is not pinned.+contents :: ManagedCString -> CString+contents (ManagedCString x) = castPtr (PM.byteArrayContents x)
src/Linux/Systemd.hs view
@@ -6,13 +6,13 @@ import Foreign.C.Types (CInt(..)) import System.Posix.Types (Fd(..)) import Foreign.C.Error (Errno,getErrno)-import Posix.Socket.Types (Type(..),Domain(..))+import Posix.Socket.Types (Type(..),Family(..))  foreign import ccall unsafe "systemd/sd-daemon.h sd_listen_fds"   c_listenFds :: CInt -> IO CInt  foreign import ccall unsafe "systemd/sd-daemon.h sd_is_socket"-  c_isSocket :: Fd -> Domain -> Type -> CInt -> IO CInt+  c_isSocket :: Fd -> Family -> Type -> CInt -> IO CInt  -- | Check for file descriptors passed by the system manager. Returns -- the number of received file descriptors. If no file descriptors@@ -24,7 +24,7 @@  isSocket ::       Fd -- ^ File descriptor-  -> Domain -- ^ Socket family+  -> Family -- ^ Socket family   -> Type -- ^ Socket type   -> CInt -- ^ Positive: require listen mode. Zero: require non-listening mode.   -> IO (Either Errno CInt)
src/Posix/File.hs view
@@ -1,6 +1,7 @@ {-# language BangPatterns #-} {-# language BinaryLiterals #-} {-# language MagicHash #-}+{-# language TypeApplications #-} {-# language UnliftedFFITypes #-}  module Posix.File@@ -8,8 +9,19 @@     uninterruptibleGetDescriptorFlags   , uninterruptibleGetStatusFlags   , uninterruptibleWriteByteArray+  , uninterruptibleWriteBytes+  , uninterruptibleWriteBytesCompletely+  , uninterruptibleOpen+  , uninterruptibleOpenMode   , writeByteArray+  , close+  , uninterruptibleClose+  , uninterruptibleErrorlessClose+  , uninterruptibleUnlink+  , uninterruptibleLink     -- * Types+  , AccessMode(..)+  , CreationFlags(..)   , DescriptorFlags(..)   , StatusFlags(..)     -- * File Descriptor Flags@@ -18,16 +30,27 @@   , isReadOnly   , isWriteOnly   , isReadWrite+    -- * Open Access Mode+  , Types.readOnly+  , Types.writeOnly+  , Types.readWrite+    -- * File Creation Flags+  , Types.create+  , Types.truncate+  , Types.exclusive   ) where  import Assertion (assertByteArrayPinned)-import Data.Bits ((.&.))-import Posix.File.Types (DescriptorFlags(..),StatusFlags(..))-import System.Posix.Types (Fd(..),CSsize(..))+import Data.Bits ((.&.),(.|.))+import Data.Primitive (ByteArray(..)) import Foreign.C.Error (Errno,getErrno)+import Foreign.C.String.Managed (ManagedCString(..)) import Foreign.C.Types (CInt(..),CSize(..))-import Data.Primitive (ByteArray(..)) import GHC.Exts (ByteArray#)+import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..))+import Posix.File.Types (DescriptorFlags(..))+import System.Posix.Types (Fd(..),CSsize(..),CMode(..))+import Data.Bytes.Types (Bytes(Bytes))  import qualified Posix.File.Types as Types @@ -50,9 +73,49 @@ foreign import ccall unsafe "HaskellPosix.h write_offset"   c_unsafe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize +foreign import ccall unsafe "HaskellPosix.h write_offset_loop"+  c_unsafe_bytearray_write_loop :: Fd -> ByteArray# -> Int -> CSize -> IO CInt+ foreign import ccall safe "HaskellPosix.h write_offset"   c_safe_bytearray_write :: Fd -> ByteArray# -> Int -> CSize -> IO CSsize +foreign import ccall unsafe "HaskellPosix.h open"+  c_unsafe_open :: ByteArray# -> CInt -> IO Fd++foreign import ccall unsafe "HaskellPosix.h open"+  c_unsafe_open_mode :: ByteArray# -> CInt -> CMode -> IO Fd++foreign import ccall unsafe "HaskellPosix.h unlink"+  c_unsafe_unlink :: ByteArray# -> IO CInt++foreign import ccall unsafe "HaskellPosix.h link"+  c_unsafe_link :: ByteArray# -> ByteArray# -> IO CInt++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++uninterruptibleOpen ::+     ManagedCString -- ^ NULL-terminated file name+  -> AccessMode -- ^ Access mode+  -> CreationFlags -- ^ Creation flags+  -> StatusFlags -- ^ Status flags+  -> IO (Either Errno Fd)+uninterruptibleOpen (ManagedCString (ByteArray name)) (AccessMode x) (CreationFlags y) (StatusFlags z) =+  c_unsafe_open name (x .|. y .|. z) >>= errorsFromFd++uninterruptibleOpenMode ::+     ManagedCString -- ^ NULL-terminated file name+  -> AccessMode -- ^ Access mode, should include @O_CREAT@+  -> CreationFlags -- ^ Creation flags+  -> StatusFlags -- ^ Status flags+  -> CMode -- ^ Permissions assigned to newly created file+  -> IO (Either Errno Fd)+uninterruptibleOpenMode (ManagedCString (ByteArray name)) (AccessMode x) (CreationFlags y) (StatusFlags z) !mode =+  c_unsafe_open_mode name (x .|. y .|. z) mode >>= errorsFromFd+ errorsFromDescriptorFlags :: DescriptorFlags -> IO (Either Errno DescriptorFlags) errorsFromDescriptorFlags r@(DescriptorFlags x) = if x > (-1)   then pure (Right r)@@ -63,6 +126,26 @@   then pure (Right r)   else fmap Left getErrno +-- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.+-- The byte array backing the slice does not need to be pinned.+uninterruptibleWriteBytesCompletely ::+     Fd -- ^ File descriptor+  -> Bytes -- ^ Source bytes+  -> IO (Either Errno ())+uninterruptibleWriteBytesCompletely !fd (Bytes (ByteArray buf) off len) =+  c_unsafe_bytearray_write_loop fd buf off (fromIntegral @Int @CSize len)+    >>= errorsFromInt_++-- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.+-- The byte array backing the slice does not need to be pinned.+uninterruptibleWriteBytes ::+     Fd -- ^ File descriptor+  -> Bytes -- ^ Source bytes+  -> IO (Either Errno CSize) -- ^ Number of bytes written+uninterruptibleWriteBytes !fd (Bytes (ByteArray buf) off len) =+  c_unsafe_bytearray_write fd buf off (fromIntegral @Int @CSize len)+    >>= errorsFromSize+ -- | Wrapper for @write(2)@ that takes a byte array and an offset. -- The byte array does not need to be pinned. uninterruptibleWriteByteArray :: @@ -74,7 +157,8 @@ uninterruptibleWriteByteArray !fd (ByteArray buf) !off !len =   c_unsafe_bytearray_write fd buf off len >>= errorsFromSize --- | Wrapper for @write(2)@ that takes a byte array and an offset. Uses @safe@ FFI. The byte array must be pinned.+-- | Wrapper for @write(2)@ that takes a byte array and an offset.+-- Uses @safe@ FFI. The byte array must be pinned. writeByteArray ::       Fd -- ^ Socket   -> ByteArray -- ^ Source byte array@@ -90,6 +174,57 @@   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++uninterruptibleLink ::+     ManagedCString -- ^ Path to existing file+  -> ManagedCString -- ^ Path to new file+  -> IO (Either Errno ())+uninterruptibleLink (ManagedCString (ByteArray x)) (ManagedCString (ByteArray y)) =+  c_unsafe_link x y >>= errorsFromInt_++uninterruptibleUnlink ::+     ManagedCString -- ^ File name+  -> IO (Either Errno ())+uninterruptibleUnlink (ManagedCString (ByteArray x)) =+  c_unsafe_unlink x >>= errorsFromInt_++-- | Close a file descriptor.+--   The <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>+--   includes more details. This uses the safe FFI.+close ::+     Fd -- ^ Socket+  -> IO (Either Errno ())+close fd = c_safe_close fd >>= errorsFromInt_++-- | Close a file descriptor. 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."+uninterruptibleClose ::+     Fd -- ^ Socket+  -> IO (Either Errno ())+uninterruptibleClose fd = c_unsafe_close fd >>= errorsFromInt_++-- | Close a file descriptor with the unsafe FFI. Do not check for errors.+--   It is only appropriate to use this when a file descriptor is being+--   closed to handle an exceptional case. Since the user will want to+--   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 ()+ -- only call this when it is known that the argument is non-negative cssizeToCSize :: CSsize -> CSize cssizeToCSize = fromIntegral@@ -102,3 +237,12 @@  isReadWrite :: StatusFlags -> Bool isReadWrite (StatusFlags x) = x .&. 0b11 == 2++-- 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+
src/Posix/File/Types.hsc view
@@ -22,11 +22,23 @@ module Posix.File.Types   ( DescriptorFlags(..)   , StatusFlags(..)+  , CreationFlags(..)+  , AccessMode(..)+    -- * Open Access Mode+  , readOnly+  , writeOnly+  , readWrite     -- * File Status Flags   , nonblocking   , append+    -- * File Creation Flags+  , create+  , truncate+  , exclusive   ) where +import Prelude hiding (truncate)+ import Data.Bits (Bits,(.|.)) import Foreign.C.Types (CInt) @@ -40,12 +52,35 @@   deriving stock (Eq)   deriving newtype (Bits) +-- | File Creation Flags+newtype CreationFlags = CreationFlags CInt+  deriving stock (Eq)+  deriving newtype (Bits)++newtype AccessMode = AccessMode CInt+  deriving stock (Eq)+ instance Semigroup DescriptorFlags where (<>) = (.|.) instance Monoid DescriptorFlags where mempty = DescriptorFlags 0 +instance Semigroup CreationFlags where (<>) = (.|.)+instance Monoid CreationFlags where mempty = CreationFlags 0+ instance Semigroup StatusFlags where (<>) = (.|.) instance Monoid StatusFlags where mempty = StatusFlags 0 +-- | The @O_RDONLY@ access mode.+readOnly :: AccessMode+readOnly = AccessMode #{const O_RDONLY}++-- | The @O_WRONLY@ access mode.+writeOnly :: AccessMode+writeOnly = AccessMode #{const O_WRONLY}++-- | The @O_RDWR@ access mode.+readWrite :: AccessMode+readWrite = AccessMode #{const O_RDWR}+ -- | The @O_NONBLOCK@ flag nonblocking :: StatusFlags nonblocking = StatusFlags #{const O_NONBLOCK}@@ -53,3 +88,15 @@ -- | The @O_APPEND@ flag append :: StatusFlags append = StatusFlags #{const O_APPEND}++-- | The @O_CREAT@ flag+create :: CreationFlags+create = CreationFlags #{const O_CREAT}++-- | The @O_TRUNC@ flag+truncate :: CreationFlags+truncate = CreationFlags #{const O_TRUNC}++-- | The @O_EXCL@ flag+exclusive :: CreationFlags+exclusive = CreationFlags #{const O_EXCL}
src/Posix/MessageQueue.hs view
@@ -7,18 +7,18 @@   , uninterruptibleReceiveByteArray   , uninterruptibleSendBytes     -- * Types-  , OpenMode(..)-  , OpenFlags(..)-    -- * Bit Twiddle-  , T.applyOpenFlags+  , AccessMode(..)+  , CreationFlags(..)+  , StatusFlags(..)     -- * Open Access Mode-  , T.readOnly-  , T.writeOnly-  , T.readWrite+  , F.readOnly+  , F.writeOnly+  , F.readWrite     -- * Open Flags-  , T.nonblocking+  , F.nonblocking   ) where +import Data.Bits ((.|.)) import GHC.Exts (RealWorld,ByteArray#,MutableByteArray#,Addr#) import GHC.Exts (Int(I#)) import System.Posix.Types (Fd(..),CSsize(..))@@ -27,11 +27,11 @@ import Foreign.C.String (CString) import Data.Primitive (MutableByteArray(..),ByteArray(..)) import Data.Bytes.Types (Bytes(Bytes))-import Posix.MessageQueue.Types (OpenMode(..),OpenFlags(..))+import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..)) import qualified GHC.Exts as Exts import qualified Data.Primitive as PM import qualified Control.Monad.Primitive as PM-import qualified Posix.MessageQueue.Types as T+import qualified Posix.File.Types as F  foreign import ccall unsafe "mqueue.h mq_receive"   c_unsafe_mq_receive :: Fd -> MutableByteArray# RealWorld@@ -42,14 +42,16 @@     -> ByteArray# -> Int -> CSize -> CUInt -> IO CInt  foreign import ccall safe "mqueue.h mq_open"-  c_safe_mq_open :: CString -> OpenMode -> IO Fd+  c_safe_mq_open :: CString -> CInt -> IO Fd  open ::      CString -- ^ NULL-terminated name of queue, must start with slash-  -> OpenMode -- ^ Access mode and flags+  -> AccessMode -- ^ Access mode+  -> CreationFlags -- ^ Creation flags+  -> StatusFlags -- ^ Status flags   -> IO (Either Errno Fd)-open !name !mode =-  c_safe_mq_open name mode >>= errorsFromFd+open !name (AccessMode x) (CreationFlags y) (StatusFlags z) =+  c_safe_mq_open name (x .|. y .|. z) >>= errorsFromFd  uninterruptibleReceiveByteArray ::      Fd -- ^ Message queue
src/Posix/MessageQueue/Types.hsc view
@@ -4,11 +4,6 @@ module Posix.MessageQueue.Types   ( OpenMode(..)   , OpenFlags(..)-  , applyOpenFlags-    -- * Open Access Mode-  , readOnly-  , writeOnly-  , readWrite     -- * Open Flags   , nonblocking   ) where@@ -24,22 +19,6 @@   OpenFlags x <> OpenFlags y = OpenFlags (x .|. y) instance Monoid OpenFlags where mempty = OpenFlags 0 --- | The @O_RDONLY@ access mode.-readOnly :: OpenMode-readOnly = OpenMode #{const O_RDONLY}---- | The @O_WRONLY@ access mode.-writeOnly :: OpenMode-writeOnly = OpenMode #{const O_WRONLY}---- | The @O_RDWR@ access mode.-readWrite :: OpenMode-readWrite = OpenMode #{const O_RDWR}- -- | The @O_NONBLOCK@ open flag. nonblocking :: OpenFlags nonblocking = OpenFlags #{const O_NONBLOCK}--applyOpenFlags :: OpenFlags -> OpenMode -> OpenMode-applyOpenFlags (OpenFlags s) (OpenMode t) = OpenMode (s .|. t)-
src/Posix/Socket.hs view
@@ -6,6 +6,7 @@ {-# language LambdaCase #-} {-# language MagicHash #-} {-# language NamedFieldPuns #-}+{-# language PatternSynonyms #-} {-# language ScopedTypeVariables #-} {-# language UnboxedTuples #-} {-# language UnliftedFFITypes #-}@@ -32,6 +33,9 @@     uninterruptibleSocket     -- ** Socket Pair   , uninterruptibleSocketPair+    -- ** Address Resolution+  , getAddressInfo+  , uninterruptibleFreeAddressInfo     -- ** Bind   , uninterruptibleBind     -- ** Connect@@ -48,11 +52,13 @@     -- ** Get Socket Option   , uninterruptibleGetSocketOption     -- ** Set Socket Option+  , uninterruptibleSetSocketOption+  , uninterruptibleSetSocketOptionByteArray   , uninterruptibleSetSocketOptionInt     -- ** Close-  , close-  , uninterruptibleClose-  , uninterruptibleErrorlessClose+  , F.close+  , F.uninterruptibleClose+  , F.uninterruptibleErrorlessClose     -- ** Shutdown   , uninterruptibleShutdown     -- ** Send@@ -96,7 +102,7 @@   , networkToHostLong   , networkToHostShort     -- * Types-  , Domain(..)+  , Family(..)   , Type(..)   , Protocol(..)   , OptionName(..)@@ -105,6 +111,7 @@   , Message(..)   , MessageFlags(..)   , ShutdownType(..)+  , AddressInfo     -- * Socket Address     -- ** Types   , SocketAddress(..)@@ -120,10 +127,10 @@   , PSP.sizeofSocketAddressInternet     -- * Data Construction     -- ** Socket Domains-  , PST.unix-  , PST.unspecified-  , PST.internet-  , PST.internet6+  , pattern PST.Unix+  , pattern PST.Unspecified+  , pattern PST.Internet+  , pattern PST.Internet6     -- ** Socket Types   , PST.stream   , PST.datagram@@ -151,13 +158,28 @@   , PST.levelSocket     -- ** Option Names   , PST.optionError+  , PST.bindToDevice   , PST.broadcast+  , PST.reuseAddress+    -- ** Address Info+    -- *** Peek+  , PST.peekAddressInfoFlags+    -- *** Poke+  , PST.pokeAddressInfoFlags+    -- *** Metadata+  , PST.sizeofAddressInfo     -- ** Message Header     -- *** Peek   , PST.peekMessageHeaderName   , PST.peekMessageHeaderNameLength   , PST.peekMessageHeaderIOVector   , PST.peekMessageHeaderIOVectorLength+  , PST.peekMessageHeaderControl+  , PST.peekMessageHeaderControlLength+  , PST.peekMessageHeaderFlags+  , PST.peekControlMessageHeaderLevel+  , PST.peekControlMessageHeaderLength+  , PST.peekControlMessageHeaderType     -- *** Poke   , PST.pokeMessageHeaderName   , PST.pokeMessageHeaderNameLength@@ -188,19 +210,22 @@ import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset(..)) import Data.Word (Word8,Word16,Word32,byteSwap16,byteSwap32) import Data.Void (Void)-import Foreign.C.Error (Errno,getErrno)+import Foreign.C.Error (Errno(Errno),getErrno)+import Foreign.C.String (CString) import Foreign.C.Types (CInt(..),CSize(..)) import Foreign.Ptr (nullPtr) import GHC.Exts (Ptr,RealWorld,ByteArray#,MutableByteArray#) import GHC.Exts (Addr#,TYPE,RuntimeRep(UnliftedRep)) import GHC.Exts (ArrayArray#,MutableArrayArray#,Int(I#)) import GHC.Exts (shrinkMutableByteArray#,touch#)-import Posix.Socket.Types (Domain(..),Protocol(..),Type(..),SocketAddress(..))+import Posix.Socket.Types (Family(..),Protocol(..),Type(..),SocketAddress(..)) import Posix.Socket.Types (SocketAddressInternet(..)) import Posix.Socket.Types (MessageFlags(..),Message(..),ShutdownType(..)) import Posix.Socket.Types (Level(..),OptionName(..),OptionValue(..))+import Posix.Socket.Types (AddressInfo) import System.Posix.Types (Fd(..),CSsize(..)) +import qualified Posix.File as F import qualified Posix.Socket.Types as PST import qualified Data.Primitive as PM import qualified Data.Primitive.Unlifted.Array as PM@@ -211,21 +236,28 @@ -- to serialize some of various kind of socket address types. import qualified Posix.Socket.Platform as PSP +-- getaddrinfo cannot use the unsafe ffi+foreign import ccall safe "sys/socket.h getaddrinfo"+  c_safe_getaddrinfo ::+       CString+    -> CString+    -> Ptr AddressInfo+    -> MutableByteArray# RealWorld -- actually a `Ptr (Ptr AddressInfo))`.+    -> IO Errno++-- | Free the @addrinfo@ at the pointer.+foreign import ccall safe "sys/socket.h freeaddrinfo"+  uninterruptibleFreeAddressInfo :: Ptr AddressInfo -> IO ()+ foreign import ccall unsafe "sys/socket.h socket"-  c_socket :: Domain -> Type -> Protocol -> IO Fd+  c_socket :: Family -> Type -> Protocol -> IO Fd  foreign import ccall unsafe "sys/socket.h socketpair"-  c_socketpair :: Domain -> Type -> Protocol -> MutableByteArray# RealWorld -> IO CInt+  c_socketpair :: Family -> Type -> Protocol -> MutableByteArray# RealWorld -> IO CInt  foreign import ccall unsafe "sys/socket.h listen"   c_listen :: Fd -> CInt -> IO CInt -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 @@ -282,6 +314,22 @@                           -> CInt -- option_value                           -> IO CInt +foreign import ccall unsafe "sys/socket.h setsockopt"+  c_unsafe_setsockopt :: Fd+                      -> Level+                      -> OptionName+                      -> Ptr Void -- option_val+                      -> CInt -- option_len+                      -> IO CInt++foreign import ccall unsafe "sys/socket.h setsockopt"+  c_unsafe_setsockopt_ba :: Fd+                         -> Level+                         -> OptionName+                         -> ByteArray# -- option_val+                         -> CInt -- option_len+                         -> 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.@@ -391,7 +439,7 @@ --   this function. The author believes that it cannot block for a prolonged --   period of time. uninterruptibleSocket ::-     Domain -- ^ Communications domain (e.g. 'internet', 'unix')+     Family -- ^ Communications domain (e.g. 'internet', 'unix')   -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags   -> Protocol -- ^ Protocol   -> IO (Either Errno Fd)@@ -404,7 +452,7 @@ --   this function. The author believes that it cannot block for a prolonged --   period of time. uninterruptibleSocketPair ::-     Domain -- ^ Communications domain (probably 'unix')+     Family -- ^ Communications domain (probably 'unix')   -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags   -> Protocol -- ^ Protocol   -> IO (Either Errno (Fd,Fd))@@ -420,6 +468,24 @@       pure (Right (fd1,fd2))     else fmap Left getErrno ++-- | Given node and service, which identify an Internet host and a service,+-- @getaddrinfo()@ returns one or more @addrinfo@ structures. The type of this+-- wrapper differs slightly from the type of its C counterpart. Remember to call+-- 'uninterruptibleFreeAddressInfo' when finished with the result.+getAddressInfo ::+     CString -- ^ Node, identifies an Internet host+  -> CString -- ^ Service+  -> Ptr AddressInfo -- ^ Hints+  -> IO (Either Errno (Ptr AddressInfo))+getAddressInfo !node !service !hints = do+  resBuf@(MutableByteArray resBuf#) <- PM.newPinnedByteArray (PM.sizeOf (undefined :: Ptr ()))+  c_safe_getaddrinfo node service hints resBuf# >>= \case+    Errno 0 -> do+      res <- PM.readByteArray resBuf 0+      pure (Right res)+    e -> pure (Left e)+ -- | 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>@@ -614,6 +680,33 @@ uninterruptibleSetSocketOptionInt sock level optName optValue =   c_unsafe_setsockopt_int sock level optName optValue >>= errorsFromInt_ +-- | Set the value for the option specified by the 'Option' argument for+--   the socket specified by the 'Fd' argument. The+--   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>+--   of @getsockopt@ includes more details.+uninterruptibleSetSocketOption ::+     Fd -- ^ Socket+  -> Level -- ^ Socket level+  -> OptionName -- ^ Option name+  -> Ptr Void -- ^ Option value+  -> CInt -- ^ Option value length+  -> IO (Either Errno ())+uninterruptibleSetSocketOption sock level optName optValue optLen =+  c_unsafe_setsockopt sock level optName optValue optLen >>= errorsFromInt_++-- | Variant of 'uninterruptibleSetSocketOption' that accepts the option+--   as a byte array instead of a pointer into unmanaged memory. The argument+--   does not need to be pinned.+uninterruptibleSetSocketOptionByteArray ::+     Fd -- ^ Socket+  -> Level -- ^ Socket level+  -> OptionName -- ^ Option name+  -> ByteArray -- ^ Option value+  -> CInt -- ^ Option value length+  -> IO (Either Errno ())+uninterruptibleSetSocketOptionByteArray sock level optName (ByteArray optVal) optLen =+  c_unsafe_setsockopt_ba sock level optName optVal optLen >>= errorsFromInt_+ -- | Send data from a byte array over a network socket. Users --   may specify an offset and a length to send fewer bytes than are --   actually present in the array. Since this uses the safe@@ -1140,38 +1233,6 @@       touchMutableByteArray msgHdrBuf       touchMutableByteArray sockAddrBuf       fmap Left getErrno---- | Close a socket. The <http://pubs.opengroup.org/onlinepubs/009696899/functions/close.html POSIX specification>---   includes more details. This uses the safe FFI.-close ::-     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."-uninterruptibleClose ::-     Fd -- ^ Socket-  -> IO (Either Errno ())-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 ::
src/Posix/Socket/Types.hsc view
@@ -5,6 +5,7 @@ {-# language GeneralizedNewtypeDeriving #-} {-# language KindSignatures #-} {-# language MagicHash #-}+{-# language PatternSynonyms #-} {-# language UnboxedTuples #-} {-# language NamedFieldPuns #-} @@ -13,13 +14,14 @@ {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}  #include <sys/socket.h>+#include <netdb.h> #include <netinet/in.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. module Posix.Socket.Types-  ( Domain(..)+  ( Family(..)   , Type(..)   , Protocol(..)   , Level(..)@@ -32,11 +34,14 @@   , MessageFlags(..)   , Message(..)   , ShutdownType(..)+  , AddressInfoFlags(..)+    -- * Phantom Types+  , AddressInfo     -- * Socket Families-  , unix-  , unspecified-  , internet-  , internet6+  , pattern Unix+  , pattern Unspecified+  , pattern Internet+  , pattern Internet6     -- * Socket Types   , stream   , datagram@@ -64,7 +69,25 @@   , levelSocket     -- * Option Names   , optionError+  , bindToDevice   , broadcast+  , reuseAddress+    -- * AddressInfo+    -- ** Peek+  , peekAddressInfoFlags+  , peekAddressInfoFamily+  , peekAddressInfoSocketType+  , peekAddressInfoProtocol+  , peekAddressInfoAddressLength+  , peekAddressInfoAddress+  , peekAddressInfoNext+    -- ** Poke+  , pokeAddressInfoFlags+  , pokeAddressInfoFamily+  , pokeAddressInfoSocketType+  , pokeAddressInfoProtocol+    -- ** Metadata+  , sizeofAddressInfo     -- * Message Header     -- ** Peek   , peekMessageHeaderName@@ -105,23 +128,43 @@ import Data.Primitive.Addr (Addr(..)) import Data.Word (Word16,Word32,Word64) import Foreign.C.Types (CInt(..),CSize)-import Foreign.Storable (peekByteOff,pokeByteOff)+import Foreign.Storable (Storable,peekByteOff,pokeByteOff) import GHC.Ptr (Ptr(..)) import GHC.Exts (Int(I##),Int##,(*##),(+##))  import qualified Data.Kind import qualified Data.Primitive as PM +-- | Phantom for pointers to @addrinfo@ in address resolution functions.+-- According to POSIX:+--+-- > struct addrinfo {+-- >     int              ai_flags;+-- >     int              ai_family;+-- >     int              ai_socktype;+-- >     int              ai_protocol;+-- >     socklen_t        ai_addrlen;+-- >     struct sockaddr *ai_addr;+-- >     char            *ai_canonname;+-- >     struct addrinfo *ai_next;+-- > };+data AddressInfo+ -- | A socket communications domain, sometimes referred to as a family. The spec --   mandates @AF_UNIX@, @AF_UNSPEC@, and @AF_INET@.-newtype Domain = Domain CInt+newtype Family = Family CInt+  deriving newtype (Storable)  -- | A socket type. The spec mandates @SOCK_STREAM@, @SOCK_DGRAM@, --   and @SOCK_SEQPACKET@. Other types may be available on a per-platform --   basis.+--+--   TODO: Change this to SocketType newtype Type = Type CInt+  deriving newtype (Storable)  newtype Protocol = Protocol { getProtocol :: CInt }+  deriving newtype (Storable)  newtype Level = Level CInt @@ -148,6 +191,13 @@ instance Semigroup (MessageFlags m) where (<>) = (.|.) instance Monoid (MessageFlags m) where mempty = MessageFlags 0 +newtype AddressInfoFlags = AddressInfoFlags CInt+  deriving newtype (Eq,Storable)++instance Semigroup AddressInfoFlags where+  AddressInfoFlags x <> AddressInfoFlags y = AddressInfoFlags (x .|. y)+instance Monoid AddressInfoFlags where mempty = AddressInfoFlags 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 backing this@@ -258,24 +308,24 @@ sequencedPacket = Type #{const SOCK_SEQPACKET}  -- | The @AF_UNIX@ communications domain.-unix :: Domain-unix = Domain #{const AF_UNIX}+pattern Unix :: Family+pattern Unix = Family #{const AF_UNIX}  -- | The @AF_UNSPEC@ communications domain.-unspecified :: Domain-unspecified = Domain #{const AF_UNSPEC}+pattern Unspecified :: Family+pattern Unspecified = Family #{const AF_UNSPEC}  -- | The @AF_INET@ communications domain.-internet :: Domain-internet = Domain #{const AF_INET}+pattern Internet :: Family+pattern Internet = Family #{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}+pattern Internet6 :: Family+pattern Internet6 = Family #{const AF_INET6}  -- | The @MSG_OOB@ receive flag or send flag. outOfBand :: MessageFlags m@@ -341,6 +391,14 @@ optionError :: OptionName optionError = OptionName #{const SO_ERROR} +-- | Bind to device (e.g. @SO_BINDTODEVICE@)+bindToDevice :: OptionName+bindToDevice = OptionName #{const SO_BINDTODEVICE}++-- | Allow reuse of local address (e.g. @SO_REUSEADDR@)+reuseAddress :: OptionName+reuseAddress = OptionName #{const SO_REUSEADDR}+ -- | Transmission of broadcast messages is supported (e.g. @SO_BROADCAST@) broadcast :: OptionName broadcast = OptionName #{const SO_BROADCAST}@@ -353,6 +411,7 @@   i <- #{peek struct cmsghdr, cmsg_level} (Ptr p)   pure (Level i) +-- | Get @cmsg_type@. peekControlMessageHeaderType :: Addr -> IO Type peekControlMessageHeaderType (Addr p) = do   i <- #{peek struct cmsghdr, cmsg_type} (Ptr p)@@ -363,17 +422,75 @@ -- advanceControlMessageHeaderData p = --   PM.plusAddr p (#{size struct cmsghdr}) +-- | Get @iov_base@. peekIOVectorBase :: Addr -> IO Addr peekIOVectorBase (Addr p) = do   Ptr x <- #{peek struct iovec, iov_base} (Ptr p)   pure (Addr x) +-- | Get @iov_len@. peekIOVectorLength :: Addr -> IO CSize peekIOVectorLength (Addr p) = #{peek struct iovec, iov_len} (Ptr p)  -- | The size of a serialized @msghdr@. sizeofMessageHeader :: CInt sizeofMessageHeader = #{size struct msghdr}++-- | Get @ai_flags@.+peekAddressInfoFlags :: Ptr AddressInfo -> IO AddressInfoFlags+peekAddressInfoFlags ptr = do+  x <- #{peek struct addrinfo, ai_flags} ptr+  pure (AddressInfoFlags x)++-- | Set @ai_flags@.+pokeAddressInfoFlags :: Ptr AddressInfo -> AddressInfoFlags -> IO ()+pokeAddressInfoFlags ptr (AddressInfoFlags x) = #{poke struct addrinfo, ai_flags} ptr x++-- | Get @ai_family@.+peekAddressInfoFamily :: Ptr AddressInfo -> IO Family+peekAddressInfoFamily ptr = do+  x <- #{peek struct addrinfo, ai_family} ptr+  pure (Family x)++-- | Get @ai_socktype@.+peekAddressInfoSocketType :: Ptr AddressInfo -> IO Type+peekAddressInfoSocketType ptr = do+  x <- #{peek struct addrinfo, ai_socktype} ptr+  pure (Type x)++-- | Get @ai_protocol@.+peekAddressInfoProtocol :: Ptr AddressInfo -> IO Protocol+peekAddressInfoProtocol ptr = do+  x <- #{peek struct addrinfo, ai_protocol} ptr+  pure (Protocol x)++-- | Get @ai_addrlen@.+peekAddressInfoAddressLength :: Ptr AddressInfo -> IO CInt+peekAddressInfoAddressLength ptr = #{peek struct addrinfo, ai_addrlen} ptr++-- | Get @ai_addr@.+peekAddressInfoAddress :: Ptr AddressInfo -> IO (Ptr SocketAddress)+peekAddressInfoAddress ptr = #{peek struct addrinfo, ai_addr} ptr++-- | Get @ai_next@.+peekAddressInfoNext :: Ptr AddressInfo -> IO (Ptr AddressInfo)+peekAddressInfoNext ptr = #{peek struct addrinfo, ai_next} ptr++-- | Set @ai_family@.+pokeAddressInfoFamily :: Ptr AddressInfo -> Family -> IO ()+pokeAddressInfoFamily ptr (Family x) = #{poke struct addrinfo, ai_family} ptr x++-- | Set @ai_socktype@.+pokeAddressInfoSocketType :: Ptr AddressInfo -> Type -> IO ()+pokeAddressInfoSocketType ptr (Type x) = #{poke struct addrinfo, ai_socktype} ptr x++-- | Set @ai_protocol@.+pokeAddressInfoProtocol :: Ptr AddressInfo -> Protocol -> IO ()+pokeAddressInfoProtocol ptr (Protocol x) = #{poke struct addrinfo, ai_protocol} ptr x++-- | The size of a serialized @addrinfo@.+sizeofAddressInfo :: Int+sizeofAddressInfo = #{size struct addrinfo}  -- | The size of a serialized @iovec@. sizeofIOVector :: CInt
+ src/Posix/Struct/AddressInfo/Peek.hsc view
@@ -0,0 +1,60 @@+#include <sys/socket.h>+#include <netdb.h>+#include <netinet/in.h>++{-# language DataKinds #-}++-- | Accessors for reading from @struct addrinfo@:+--+-- > struct addrinfo {+-- >     int              ai_flags;+-- >     int              ai_family;+-- >     int              ai_socktype;+-- >     int              ai_protocol;+-- >     socklen_t        ai_addrlen;+-- >     struct sockaddr *ai_addr;+-- >     char            *ai_canonname;+-- >     struct addrinfo *ai_next;+-- > };+module Posix.Struct.AddressInfo.Peek+  ( flags+  , family+  , socketType+  , protocol+  , addressLength+  , address+  , next+  ) where++import Posix.Socket.Types (AddressInfoFlags(..),SocketAddress,Family,Type,AddressInfo,Protocol)+import Foreign.C.Types (CInt)+import Foreign.Ptr (Ptr)+import Foreign.Storable (peekByteOff)++-- | Get @ai_flags@.+flags :: Ptr AddressInfo -> IO AddressInfoFlags+flags ptr = #{peek struct addrinfo, ai_flags} ptr++-- | Get @ai_family@.+family :: Ptr AddressInfo -> IO Family+family ptr = #{peek struct addrinfo, ai_family} ptr++-- | Get @ai_socktype@.+socketType :: Ptr AddressInfo -> IO Type+socketType ptr = #{peek struct addrinfo, ai_socktype} ptr++-- | Get @ai_protocol@.+protocol :: Ptr AddressInfo -> IO Protocol+protocol ptr = #{peek struct addrinfo, ai_protocol} ptr++-- | Get @ai_addrlen@.+addressLength :: Ptr AddressInfo -> IO CInt+addressLength ptr = #{peek struct addrinfo, ai_addrlen} ptr++-- | Get @ai_addr@.+address :: Ptr AddressInfo -> IO (Ptr SocketAddress)+address ptr = #{peek struct addrinfo, ai_addr} ptr++-- | Get @ai_next@.+next :: Ptr AddressInfo -> IO (Ptr AddressInfo)+next ptr = #{peek struct addrinfo, ai_next} ptr
+ src/Posix/Struct/SocketAddressInternet/Peek.hsc view
@@ -0,0 +1,38 @@+#include <sys/socket.h>+#include <netdb.h>+#include <netinet/in.h>++{-# language DataKinds #-}++-- | Accessors for reading from @struct sockaddr_in@:+--+-- > struct sockaddr_in {+-- >     sa_family_t    sin_family; /* address family: AF_INET */+-- >     in_port_t      sin_port;   /* port in network byte order */+-- >     struct in_addr sin_addr;   /* internet address */+-- > };+module Posix.Struct.SocketAddressInternet.Peek+  ( family+  , port+  , address+  ) where++import Posix.Socket.Types (SocketAddressInternet,Family)+import Foreign.Ptr (Ptr)+import Foreign.Storable (peekByteOff)+import Data.Word (Word16,Word32)+import System.ByteOrder (Fixed,ByteOrder(BigEndian))++-- | Get @sin_family@.+family :: Ptr SocketAddressInternet -> IO Family+family = #{peek struct sockaddr_in, sin_family}++-- | Get @in_port_t@.+port :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word16)+port = #{peek struct sockaddr_in, sin_port}++-- | Get @sin_addr.saddr@. This works on Linux because @struct in_addr@ has+-- a single 32-bit field. I do not know how to perform this in a portable way+-- with hsc2hs.+address :: Ptr SocketAddressInternet -> IO (Fixed 'BigEndian Word32)+address = #{peek struct sockaddr_in, sin_addr}
src/Posix/Types.hsc view
@@ -11,8 +11,14 @@  import Foreign.Storable (Storable) import Data.Bits (FiniteBits,Bits)+#if MIN_VERSION_base(4,14,0)+import System.Posix.Types (CNfds(..))+#endif  #include <poll.h> +-- This is a compatibility shim for older GHCs+#if !MIN_VERSION_base(4,14,0) newtype CNfds = CNfds #{type nfds_t}   deriving newtype (Eq,Real,Integral,Enum,Num,Ord,Storable,FiniteBits,Bits)+#endif