posix-api 0.7.1.0 → 0.7.2.0

raw patch · 22 files changed

+2255/−2569 lines, 22 filesdep −primitive-unlifteddep ~primitivesetup-changednew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: primitive-unlifted

Dependency ranges changed: primitive

API changes (from Hackage documentation)

Files

• CHANGELOG.md +21/−14
• Setup.hs +0/−2
• cbits/HaskellPosix.c +4/−1
• include/HaskellPosix.h +1/−1
• include/custom.h +0/−1
• posix-api.cabal +80/−69
• src-assertions/Assertion.hs +14/−23
• src-linux/Posix/Socket/Platform.hsc +2/−3
• src/Foreign/C/String/Managed.hs +54/−47
• src/Linux/Epoll.hs +94/−74
• src/Linux/Epoll/Types.hsc +1/−28
• src/Linux/Socket.hs +67/−351
• src/Linux/Socket/Types.hsc +3/−3
• src/Posix/Directory.hs +13/−14
• src/Posix/File.hs +212/−131
• src/Posix/MessageQueue.hs +64/−43
• src/Posix/Poll.hs +24/−23
• src/Posix/Poll/Types.hsc +2/−4
• src/Posix/Select.hs +0/−2
• src/Posix/Socket.hs +1521/−1495
• src/Posix/Types.hsc +0/−12
• test/Main.hs +78/−228

@@ -7,12 +7,19 @@  This project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). -## [0.7.1.0] - 2023-??-??+## 0.7.2.0 -- 2024-02-28 +- Add `socket` as alias for `uninterruptibleSocket`.+- Add `withSocket`.+- Removed `UNLIFTEDARRAYFUNCTIONS` flag and support for GHC < 9.4.++## 0.7.1.0 -- 2023-10-03+ - Add `uninterruptibleOpenModeUntypedFlags`. - Add `Posix.Struct.AddressInfo.Poke`.+- Add `Posix.File.uninterruptibleReadMutableByteArray`. -## [0.7.0.0] - 2023-08-30+## 0.7.0.0 -- 2023-08-30  - For now, remove all of the functions that work on UnliftedArray. These   will be added back later once hackage starts using GHC 9.4. They are@@ -20,35 +27,35 @@   with the `UNLIFTEDARRAYFUNCTIONS` flag to get them back. - Add `uninterruptibleConnectPtr` for better compatibility with `network`. -## [0.6.1.0] - 2023-08-14+## 0.6.1.0 -- 2023-08-14  - Add `uninterruptibleWriteBytesCompletelyErrno` - Add `writeBytesCompletelyErrno` - Add `uninterruptibleAccept4_` -## [0.6.0.1] - 2023-07-13+## 0.6.0.1 -- 2023-07-13  - Fix mistake in header file that caused builds to fail -## [0.6.0.0] - 2023-07-13+## 0.6.0.0 -- 2023-07-13  - Use Int instead of CInt for all offsets into byte arrays -## [0.5.0.0] - 2023-07-13+## 0.5.0.0 -- 2023-07-13  - Move Linux.Systemd to systemd-api library to make docs build on hackage. -## [0.4.0.1] - 2023-06-27+## 0.4.0.1 -- 2023-06-27  - Build with GHC 9.4 -## [0.4.0.0] - 2022-12-08+## 0.4.0.0 -- 2022-12-08  - Add `writeMutableByteArray` - In the 0.3.5.0 release, the major version was supposed to be bumped.   This is being done now instead. -## [0.3.5.0] - 2021-07-02+## 0.3.5.0 -- 2021-07-02  - Breaking: Start using pattern synonyms for macros. - Add dedicated modules for peeking at structures.@@ -57,26 +64,26 @@ - Add `uninterruptibleSetSocketOption`. - Add socket options `SO_BINDTODEVICE` and `SO_REUSEADDR`. -## [0.3.4.0] - 2020-03-09+## 0.3.4.0 -- 2020-03-09  - Add `Posix.File` - Add lower bound for `hsc2hs` build tool -## [0.3.3.0] - 2019-12-18+## 0.3.3.0 -- 2019-12-18  - Support several POSIX message queue functions. - Support Linux systemd functions. -## [0.3.2.0] - 2019-07-21+## 0.3.2.0 -- 2019-07-21  - Add more functions. -## [0.3.1.0] - YYYY-MM-DD+## 0.3.1.0 -- YYYY-MM-DD  - Make the test suite build again. - Add `uninterruptibleSendByteArrays`. -## [0.1.0.0] - 2018-01-02+## 0.1.0.0 -- 2018-01-02 - Initial release. - Includes a ton of sockets API stuff. - Includes the get working directory function.

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

@@ -21,7 +21,7 @@ #define MAX_BYTEARRAYS 64  // Generally, this library tries to avoid wrapping POSIX functions-// in an additional function. However, for some functions whose wrappers+// in an additional function. However, for some functions whose // unsafe FFI wrappers use unpinned ByteArray instead of Addr, the only // way to support providing an offset (without just copying the bytes // into pinned memory) is to use a wrapper.@@ -48,6 +48,9 @@ } ssize_t recv_offset(int socket, char *buffer, HsInt offset, size_t length, int flags) {   return recv(socket, (void*)(buffer + offset), length, flags);+}+ssize_t read_offset(int fd, char *buffer, HsInt offset, size_t length) {+  return read(fd, (void*)(buffer + offset), length); } ssize_t send_offset(int socket, const char *buffer, HsInt offset, size_t length, int flags) {   return send(socket, (const void*)(buffer + offset), length, flags);

@@ -3,6 +3,7 @@ #include <stdint.h> #include "Rts.h" +ssize_t read_offset(int socket, char *buffer, HsInt offset, size_t length); ssize_t recv_offset(int socket, char *buffer, HsInt offset, size_t length, int flags); ssize_t send_offset(int socket, const char *buffer, HsInt offset, size_t length, int flags); @@ -19,4 +20,3 @@ int recvmmsg_sockaddr_discard (int sockfd , int *lens   , StgArrBytes **bufs // used for output   , unsigned int vlen , int flags);-

@@ -72,4 +72,3 @@   } else { \     hsc_printf ("BAD_BYTEARRAY_ALIGNMENT"); \   }-

@@ -1,7 +1,7 @@-cabal-version: 2.2-name: posix-api-version: 0.7.1.0-synopsis: posix bindings+cabal-version:      3.0+name:               posix-api+version:            0.7.2.0+synopsis:           posix bindings description:   This library provides a very thin wrapper around POSIX APIs. It can be   compiled on any operating system that implements the standard as specified@@ -10,19 +10,19 @@   differs in several areas:   .   * `ByteArray` and `Addr` are used pervasively. There is no use of-    `String` in this library.+  `String` in this library.   .   * Functions do not throw errors. This library uses `IO (Either Errno a)`-    in places where `unix` would use `IO a`.+  in places where `unix` would use `IO a`.   .   * The numeric types from `Foreign.C.Types` and `System.Posix.Types` are-    used in the type signatures of functions so that a haskell function's-    type signature matches its underlying POSIX equivalent exactly.+  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.+  posix specification) rather than enumerations. The data constructors+  are exported, making the types extensible for operating system that+  have additional flags.   .   About a dozen other packages offers wrappers for some subset of the POSIX   specification are strewn across hackage. They include `regex-posix`,@@ -32,58 +32,62 @@   this package from some or all of these others:   .   * Scope. Although this library does not include all APIs specified by-    POSIX, it welcomes as many of them as anyone is willing to implement.+  POSIX, it welcomes as many of them as anyone is willing to implement.   .   * Monomorphization. Effectful functions in this library return their-    results in `IO` rather than using a type that involves `MonadIO`-    or `MonadBaseControl`.+  results in `IO` rather than using a type that involves `MonadIO`+  or `MonadBaseControl`.   .   * Typeclass avoidance. This library does not introduce new typeclasses.-    Overloading is eschewed in favor of providing multiple functions-    with distinct names.+  Overloading is eschewed in favor of providing multiple functions+  with distinct names.   .   * Minimality. Functions wrapping the POSIX APIs do little more than-    wrap the underlying functions. The major deviation here is that,-    when applicable, the wrappers allocate buffers are the underlying-    functions fill. This eschews C's characteristic buffer-passing-    in favor of the Haskell convention of allocating internally and returning.-    A more minor deviation is that for safe FFI calls, this library-    will perform additional work to ensure that only pinned byte arrays are-    handed over.+  wrap the underlying functions. The major deviation here is that,+  when applicable, the wrappers allocate buffers are the underlying+  functions fill. This eschews C's characteristic buffer-passing+  in favor of the Haskell convention of allocating internally and returning.+  A more minor deviation is that for safe FFI calls, this library+  will perform additional work to ensure that only pinned byte arrays are+  handed over.   .   Unlike `network`, this sockets API in this library does not integrate   sockets with GHC's event manager. This is geared   toward an audience that understands how to use `threadWaitRead`   and `threadWaitWrite` with unsafe FFI calls to avoid blocking   the runtime.-homepage: https://github.com/andrewthad/posix-api-license: BSD-3-Clause-license-file: LICENSE-author: Andrew Martin-maintainer: andrew.thaddeus@gmail.com-copyright: 2018 Andrew Martin-category: System-build-type: Simple++homepage:           https://github.com/byteverse/posix-api+bug-reports:        https://github.com/byteverse/posix-api/issues+license:            BSD-3-Clause+license-file:       LICENSE+author:             Andrew Martin+maintainer:         amartin@layer3com.com+copyright:          2018 Andrew Martin+category:           System+build-type:         Simple extra-source-files:-  README.md-  CHANGELOG.md   cbits/HaskellPosix.c-  include/HaskellPosix.h   include/custom.h+  include/HaskellPosix.h +extra-doc-files:+  CHANGELOG.md+  README.md++tested-with:        GHC ==9.4.8 || ==9.6.3 || ==9.8.1+ flag assertions-  manual: True-  description: Extra run-time invariant checking -  default: False+  manual:      True+  description: Extra run-time invariant checking+  default:     False --- This only exists to help get this library to build on hackage.--- Whenever hackage moves to GHC 9.4, remove this.-flag unliftedarrayfunctions-  manual: True-  description: Build and export functions using unlifted arrays-  default: False+common build-settings+  default-language: Haskell2010+  ghc-options:      -Wall -Wunused-packages  library+  import:             build-settings   exposed-modules:     Foreign.C.String.Managed     Linux.Epoll@@ -95,11 +99,13 @@     Posix.Poll     Posix.Select     Posix.Socket-    Posix.Types-    Posix.Struct.SocketAddressInternet.Peek     Posix.Struct.AddressInfo.Peek     Posix.Struct.AddressInfo.Poke+    Posix.Struct.SocketAddressInternet.Peek+    Posix.Types+   other-modules:+    Assertion     Linux.Epoll.Types     Linux.MessageQueue.Types     Linux.Socket.Types@@ -108,43 +114,48 @@     Posix.Poll.Types     Posix.Socket.Platform     Posix.Socket.Types-    Assertion+   build-depends:-    , base >=4.16.3 && <5-    , byte-order >= 0.1.2 && <0.2-    , byteslice >= 0.2.10 && <0.3-    , primitive >= 0.7 && <0.10-    , primitive-addr >= 0.1 && <0.2-    , primitive-offset >= 0.2 && <0.3-    , run-st >= 0.1.1 && <0.2-    , text-short >=0.1.5-  if flag(unliftedarrayfunctions)-    build-depends: primitive-unlifted >=2.1 && <2.2-  hs-source-dirs: src+    , base              >=4.16.3 && <5+    , byte-order        >=0.1.2  && <0.2+    , byteslice         >=0.2.10 && <0.3+    , primitive         >=0.9    && <0.10+    , primitive-addr    >=0.1    && <0.2+    , primitive-offset  >=0.2    && <0.3+    , run-st            >=0.1.1  && <0.2+    , text-short        >=0.1.5++  hs-source-dirs:     src+   if flag(assertions)     hs-source-dirs: src-assertions+   else     hs-source-dirs: src-noassertions+   if os(linux)     hs-source-dirs: src-linux-  default-language: Haskell2010-  ghc-options: -Wall -O2-  c-sources: cbits/HaskellPosix.c-  include-dirs: include-  includes: HaskellPosix.h-  build-tool-depends: hsc2hs:hsc2hs >= 0.68.5 +  ghc-options:        -O2+  c-sources:          cbits/HaskellPosix.c+  include-dirs:       include+  includes:           HaskellPosix.h+  build-tool-depends: hsc2hs:hsc2hs >=0.68.5+ test-suite test-  type: exitcode-stdio-1.0+  import:         build-settings+  type:           exitcode-stdio-1.0   hs-source-dirs: test-  main-is: Main.hs+  main-is:        Main.hs   build-depends:     , base     , posix-api+    , primitive    >=0.7     , tasty     , tasty-hunit-    , primitive >= 0.7-    , primitive-unlifted-  ghc-options: -Wall -O2 -threaded-  default-language: Haskell2010 +  ghc-options:    -threaded++source-repository head+  type:     git+  location: git://github.com/byteverse/posix-api.git

@@ -1,5 +1,4 @@-{-# language MagicHash #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE MagicHash #-}  module Assertion   ( assertByteArrayPinned@@ -7,30 +6,22 @@   , assertMutablePrimArrayPinned   ) where -import GHC.Exts (isTrue#)- import qualified Data.Primitive as PM-import qualified GHC.Exts as Exts  assertMutablePrimArrayPinned :: PM.MutablePrimArray s a -> PM.MutablePrimArray s a-assertMutablePrimArrayPinned x = if isMutablePrimArrayPinned x-  then x-  else error "assertMutablePrimArrayPinned"--assertMutableByteArrayPinned :: PM.MutablePrimArray s a -> PM.MutablePrimArray s a-assertMutableByteArrayPinned x = if isMutableByteArrayPinned x-  then x-  else error "assertMutableByteArrayPinned"--isMutablePrimArrayPinned :: PM.MutablePrimArray s a -> Bool-{-# inline isMutablePrimArrayPinned #-}-isMutablePrimArrayPinned (PM.MutablePrimArray marr#) = isTrue# (Exts.isMutableByteArrayPinned# marr#)+assertMutablePrimArrayPinned x =+  if PM.isMutablePrimArrayPinned x+    then x+    else error "assertMutablePrimArrayPinned" -isMutableByteArrayPinned :: PM.MutableByteArray s -> Bool-{-# inline isMutableByteArrayPinned #-}-isMutableByteArrayPinned (PM.MutableByteArray marr#) = isTrue# (Exts.isMutableByteArrayPinned# marr#)+assertMutableByteArrayPinned :: PM.MutableByteArray s -> PM.MutableByteArray s+assertMutableByteArrayPinned x =+  if PM.isMutableByteArrayPinned x+    then x+    else error "assertMutableByteArrayPinned"  assertByteArrayPinned :: PM.ByteArray -> PM.ByteArray-assertByteArrayPinned x = if PM.isByteArrayPinned x-  then x-  else error "assertByteArrayPinned"+assertByteArrayPinned x =+  if PM.isByteArrayPinned x+    then x+    else error "assertByteArrayPinned"

@@ -40,7 +40,7 @@ import qualified Data.Primitive.Addr as PMA import qualified Foreign.Storable as FS --- | The size of a serialized internet socket address.  +-- | The size of a serialized internet socket address. sizeofSocketAddressInternet :: CInt sizeofSocketAddressInternet = #{size struct sockaddr_in} @@ -115,7 +115,7 @@ --   error code. encodeSocketAddressUnix :: SocketAddressUnix -> SocketAddress encodeSocketAddressUnix (SocketAddressUnix !name) =-  SocketAddress $ runByteArrayST $ unboxByteArrayST $ 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.@@ -142,4 +142,3 @@ -- data constructor allocation. runByteArrayST :: (State## RealWorld -> (## State## RealWorld, ByteArray## ##)) -> ByteArray runByteArrayST st_rep = case runRW## st_rep of (## _, a ##) -> ByteArray a-

@@ -1,14 +1,14 @@-{-# language BangPatterns #-}-{-# language DerivingStrategies #-}-{-# language GeneralizedNewtypeDeriving #-}-{-# language MagicHash #-}-{-# language MultiWayIf #-}-{-# language TypeApplications #-}-{-# language ScopedTypeVariables #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnboxedTuples #-}  module Foreign.C.String.Managed-  ( ManagedCString(..)+  ( ManagedCString (..)   , terminated   , terminatedU   , unterminated@@ -23,25 +23,24 @@  import Control.Monad.ST (ST) import Control.Monad.ST.Run (runByteArrayST)-import Data.Bytes.Types (Bytes(Bytes))+import Data.Bytes.Types (Bytes (Bytes)) import Data.Char (ord)-import Data.Primitive (ByteArray(..),MutableByteArray)+import Data.Primitive (ByteArray (..), MutableByteArray) import Data.Text.Short (ShortText) 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 GHC.Exts (ByteArray#, Char (C#), Int (I#), chr#, touch#)+import GHC.IO (IO (IO))  import qualified Data.Bytes as Bytes import qualified Data.Bytes.Text.Utf8 as Utf8 import qualified Data.Primitive as PM-import qualified Data.Text.Short as TS import qualified GHC.Exts as Exts  -- | An unsliced byte sequence with @NUL@ as the final byte. newtype ManagedCString = ManagedCString ByteArray-  deriving newtype Eq+  deriving newtype (Eq)  instance Semigroup ManagedCString where   ManagedCString a <> ManagedCString b = ManagedCString $ runByteArrayST $ do@@ -62,14 +61,18 @@   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+  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@@ -100,13 +103,14 @@   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+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@@ -114,32 +118,35 @@ 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.+{- | 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 #-}+{-# NOINLINE fromLatinString #-} fromLatinString str = ManagedCString $ runByteArrayST $ do   let lenPred0 = 63   dst0 <- PM.newByteArray (lenPred0 + 1)   go str dst0 0 lenPred0-  where+ 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+  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.+{- | 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)

@@ -1,30 +1,34 @@-{-# language BangPatterns #-}-{-# language DataKinds #-}-{-# language GADTSyntax #-}-{-# language KindSignatures #-}-{-# language MagicHash #-}-{-# language UnliftedFFITypes #-}-{-# language NamedFieldPuns #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}  module Linux.Epoll   ( -- * Functions+     -- ** Create     uninterruptibleCreate   , uninterruptibleCreate1+     -- ** Wait   , waitMutablePrimArray   , uninterruptibleWaitMutablePrimArray+     -- ** Control   , uninterruptibleControlMutablePrimArray+     -- * Types-  , EpollFlags(..)-  , ControlOperation(..)-  , Events(..)-  , Event(..)-  , Exchange(..)+  , EpollFlags (..)+  , ControlOperation (..)+  , Events (..)+  , Event (..)+  , Exchange (..)+     -- * Classes   , PrimEpollData+     -- * Constants   , T.closeOnExec   , T.add@@ -37,9 +41,11 @@   , T.readHangup   , T.error   , T.edgeTriggered+     -- * Events Combinators   , T.containsAnyEvents   , T.containsAllEvents+     -- * Marshalling   , T.sizeofEvent   , T.peekEventEvents@@ -48,21 +54,17 @@   , T.peekEventDataU32   , T.peekEventDataU64   , T.pokeEventDataU64-  -- , T.readEventDataU64-  -- , T.writeEventDataU64-  -- , T.writeEventEvents   ) where  import Prelude hiding (error)  import Assertion (assertMutablePrimArrayPinned)-import Data.Primitive (MutablePrimArray(..))-import Foreign.C.Error (Errno,getErrno)-import Foreign.C.Types (CInt(..))-import GHC.Exts (RealWorld,MutableByteArray#)-import Linux.Epoll.Types (EpollFlags(..),ControlOperation(..),Events(..),Exchange(..))-import Linux.Epoll.Types (Event(..),PrimEpollData(..))-import System.Posix.Types (Fd(..))+import Data.Primitive (MutablePrimArray (..))+import Foreign.C.Error (Errno, getErrno)+import Foreign.C.Types (CInt (..))+import GHC.Exts (MutableByteArray#, RealWorld)+import Linux.Epoll.Types (ControlOperation (..), EpollFlags (..), Event (..), Events (..), Exchange (..), PrimEpollData (..))+import System.Posix.Types (Fd (..))  import qualified Linux.Epoll.Types as T @@ -93,81 +95,99 @@ --   PM.writeByteArray arr (ix * 3 + 2) (word64ToWord32 payload)  uninterruptibleCreate ::-     CInt -- ^ Size, ignored since Linux 2.6.8-  -> IO (Either Errno Fd)-{-# inline uninterruptibleCreate #-}+  -- | Size, ignored since Linux 2.6.8+  CInt ->+  IO (Either Errno Fd)+{-# INLINE uninterruptibleCreate #-} uninterruptibleCreate !sz = c_epoll_create sz >>= errorsFromFd  uninterruptibleCreate1 ::-     EpollFlags -- ^ Flags-  -> IO (Either Errno Fd)-{-# inline uninterruptibleCreate1 #-}+  -- | Flags+  EpollFlags ->+  IO (Either Errno Fd)+{-# INLINE uninterruptibleCreate1 #-} uninterruptibleCreate1 !flags =   c_epoll_create1 flags >>= errorsFromFd --- | Wait for an I/O event on an epoll file descriptor. The---   <https://linux.die.net/man/2/epoll_wait Linux man page>---   includes more details. The @timeout@ argument is omitted---   since it is nonsense to choose anything other than 0 when---   using the unsafe FFI.+{- | Wait for an I/O event on an epoll file descriptor. The+  <https://linux.die.net/man/2/epoll_wait Linux man page>+  includes more details. The @timeout@ argument is omitted+  since it is nonsense to choose anything other than 0 when+  using the unsafe FFI.+-} uninterruptibleWaitMutablePrimArray ::-     Fd -- ^ EPoll file descriptor-  -> MutablePrimArray RealWorld (Event 'Response a) -- ^ Event buffer-  -> CInt -- ^ Maximum events-  -> IO (Either Errno CInt) -- ^ Number of events received-{-# inline uninterruptibleWaitMutablePrimArray #-}+  -- | EPoll file descriptor+  Fd ->+  -- | Event buffer+  MutablePrimArray RealWorld (Event 'Response a) ->+  -- | Maximum events+  CInt ->+  -- | Number of events received+  IO (Either Errno CInt)+{-# INLINE uninterruptibleWaitMutablePrimArray #-} uninterruptibleWaitMutablePrimArray !epfd (MutablePrimArray evs) !maxEvents =   c_epoll_wait_unsafe epfd evs maxEvents 0 >>= errorsFromInt --- | Wait for an I/O event on an epoll file descriptor. The---   <https://linux.die.net/man/2/epoll_wait Linux man page>---   includes more details. The event buffer must be a pinned---   byte array.+{- | Wait for an I/O event on an epoll file descriptor. The+  <https://linux.die.net/man/2/epoll_wait Linux man page>+  includes more details. The event buffer must be a pinned+  byte array.+-} waitMutablePrimArray ::-     Fd -- ^ EPoll file descriptor-  -> MutablePrimArray RealWorld (Event 'Response a) -- ^ Event buffer, must be pinned-  -> CInt -- ^ Maximum events-  -> CInt -- ^ Timeout in milliseconds, use @-1@ to block forever.-  -> IO (Either Errno CInt) -- ^ Number of events received-{-# inline waitMutablePrimArray #-}+  -- | EPoll file descriptor+  Fd ->+  -- | Event buffer, must be pinned+  MutablePrimArray RealWorld (Event 'Response a) ->+  -- | Maximum events+  CInt ->+  -- | Timeout in milliseconds, use @-1@ to block forever.+  CInt ->+  -- | Number of events received+  IO (Either Errno CInt)+{-# INLINE waitMutablePrimArray #-} waitMutablePrimArray !epfd !evs !maxEvents !timeout =   let !(MutablePrimArray evs#) = assertMutablePrimArrayPinned evs    in c_epoll_wait_safe epfd evs# maxEvents timeout >>= errorsFromInt --- | Add, modify, or remove entries in the interest list of the---   epoll instance referred to by the file descriptor @epfd@.---   <https://linux.die.net/man/2/epoll_ctl Linux man page>---   includes more details.+{- | Add, modify, or remove entries in the interest list of the+  epoll instance referred to by the file descriptor @epfd@.+  <https://linux.die.net/man/2/epoll_ctl Linux man page>+  includes more details.+-} uninterruptibleControlMutablePrimArray ::-     Fd -- ^ EPoll file descriptor (@epfd@)-  -> ControlOperation-     -- ^ Operation: @EPOLL_CTL_ADD@, @EPOLL_CTL_MOD@, or @EPOLL_CTL_DEL@-  -> Fd -- ^ File descriptor whose registration will be affected-  -> MutablePrimArray RealWorld (Event 'Request a)-     -- ^ A single event. This is read from, not written to.-  -> IO (Either Errno ())-{-# inline uninterruptibleControlMutablePrimArray #-}+  -- | EPoll file descriptor (@epfd@)+  Fd ->+  -- | Operation: @EPOLL_CTL_ADD@, @EPOLL_CTL_MOD@, or @EPOLL_CTL_DEL@+  ControlOperation ->+  -- | File descriptor whose registration will be affected+  Fd ->+  -- | A single event. This is read from, not written to.+  MutablePrimArray RealWorld (Event 'Request a) ->+  IO (Either Errno ())+{-# INLINE uninterruptibleControlMutablePrimArray #-} uninterruptibleControlMutablePrimArray !epfd !op !fd (MutablePrimArray ev) =   c_epoll_ctl_unsafe epfd op fd ev >>= errorsFromInt_  errorsFromFd :: Fd -> IO (Either Errno Fd)-{-# inline errorsFromFd #-}-errorsFromFd r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno+{-# INLINE errorsFromFd #-}+errorsFromFd r =+  if r > (-1)+    then pure (Right r)+    else fmap Left getErrno  errorsFromInt :: CInt -> IO (Either Errno CInt)-{-# inline errorsFromInt #-}-errorsFromInt r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno+{-# INLINE errorsFromInt #-}+errorsFromInt r =+  if r > (-1)+    then pure (Right r)+    else fmap Left getErrno  -- Sometimes, functions that return an int use zero to indicate -- success and negative one to indicate failure without including -- additional information in the value. errorsFromInt_ :: CInt -> IO (Either Errno ())-{-# inline errorsFromInt_ #-}-errorsFromInt_ r = if r == 0-  then pure (Right ())-  else fmap Left getErrno-+{-# INLINE errorsFromInt_ #-}+errorsFromInt_ r =+  if r == 0+    then pure (Right ())+    else fmap Left getErrno

@@ -11,7 +11,7 @@ {-# language PolyKinds #-} {-# language ScopedTypeVariables #-} {-# language TypeApplications #-}-{-# language TypeInType #-}+{-# language DataKinds #-} {-# language UnboxedTuples #-}  -- This is needed because hsc2hs does not currently handle ticked@@ -334,30 +334,3 @@  unI :: Int -> Int## unI (I## i) = i---- -- | Read @data.u64@ from @struct epoll_event@.--- readEventDataU64 ::---      MutableByteArray RealWorld---   -> Int -- ^ Index. Elements are @struct epoll_event@.---   -> IO Word64--- readEventDataU64 !arr !ix = do---   -- On 64-bit platforms, Linux bitpacks this structure, causing the---   -- data (a 64-bit word) to be misaligned. Consequently, we must---   -- hardcode the assumed offsets to perform only aligned accesses.---   -- The behavior is deterministic across platforms of different---   -- endianness only if the only use of this function is paired with---   -- writeEventDataU64.---   (a :: Word32) <- PM.readByteArray arr (ix * 3 + 1)---   (b :: Word32) <- PM.readByteArray arr (ix * 3 + 2)---   pure (unsafeShiftL (word32ToWord64 a) 32 .|. word32ToWord64 b)--- --- -- | Write @data.u64@ from @struct epoll_event@.--- writeEventDataU64 ::---      MutableByteArray RealWorld---   -> Int -- ^ Index. Element are @struct epoll_event@.---   -> Word64 -- ^ Data---   -> IO ()--- writeEventDataU64 !arr !ix !payload = do---   -- See the comments on readEventDataU64---   PM.writeByteArray arr (ix * 3 + 1) (word64ToWord32 (unsafeShiftR payload 32))---   PM.writeByteArray arr (ix * 3 + 2) (word64ToWord32 payload)

@@ -1,40 +1,40 @@-{-# language BangPatterns #-}-{-# language CPP #-}-{-# language DataKinds #-}-{-# language MagicHash #-}-{-# language ScopedTypeVariables #-}-{-# language UnboxedTuples #-}-{-# language UnliftedFFITypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnliftedFFITypes #-}  module Linux.Socket   ( -- * Functions     uninterruptibleAccept4   , uninterruptibleAccept4_-#if defined(UNLIFTEDARRAYFUNCTIONS)-  , uninterruptibleReceiveMultipleMessageA-  , uninterruptibleReceiveMultipleMessageB-  , uninterruptibleReceiveMultipleMessageC-  , uninterruptibleReceiveMultipleMessageD-#endif+     -- * Types-  , SocketFlags(..)+  , SocketFlags (..)+     -- * Option Names   , LST.headerInclude+     -- * Message Flags   , LST.dontWait   , LST.truncate   , LST.controlTruncate+     -- * Socket Flags   , LST.closeOnExec   , LST.nonblocking+     -- * Twiddle   , applySocketFlags+     -- * UDP Header   , LST.sizeofUdpHeader   , LST.pokeUdpHeaderSourcePort   , LST.pokeUdpHeaderDestinationPort   , LST.pokeUdpHeaderLength   , LST.pokeUdpHeaderChecksum+     -- * IPv4 Header   , LST.sizeofIpHeader   , LST.pokeIpHeaderVersionIhl@@ -51,333 +51,74 @@  import Prelude hiding (truncate) -import Control.Monad (when) import Data.Bits ((.|.))-import Data.Primitive (MutableByteArray(..),ByteArray(..),MutablePrimArray(..))-import Data.Primitive.Addr (Addr(..),plusAddr,nullAddr)-#if defined(UNLIFTEDARRAYFUNCTIONS)-import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray)-import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray))-import Data.Primitive.Unlifted.Array.Primops (MutableUnliftedArray#(MutableUnliftedArray#))-#endif+import Data.Primitive (MutableByteArray (..)) import Data.Void (Void)-import Data.Word (Word8)-import Foreign.C.Error (Errno,getErrno)-import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))+import Foreign.C.Error (Errno, getErrno)+import Foreign.C.Types (CInt (..)) import Foreign.Ptr (nullPtr)-import GHC.Exts (Ptr(..),RealWorld,MutableArray#,MutableByteArray#,Addr#,Int(I#))-import GHC.Exts (shrinkMutableByteArray#,touch#,nullAddr#)-import GHC.IO (IO(..))-import Linux.Socket.Types (SocketFlags(..))-import Posix.Socket (Type(..),MessageFlags(..),Message(Receive),SocketAddress(..))-import System.Posix.Types (Fd(..),CSsize(..))+import GHC.Exts (Int (I#), MutableByteArray#, Ptr (..), RealWorld, shrinkMutableByteArray#)+import Linux.Socket.Types (SocketFlags (..))+import Posix.Socket (SocketAddress (..), Type (..))+import System.Posix.Types (Fd (..))  import qualified Control.Monad.Primitive as PM import qualified Data.Primitive as PM-#if defined(UNLIFTEDARRAYFUNCTIONS)-import qualified Data.Primitive.Unlifted.Array as PM-#endif import qualified Linux.Socket.Types as LST-import qualified Posix.Socket as S -foreign import ccall unsafe "sys/socket.h recvmmsg"-  c_unsafe_addr_recvmmsg :: Fd-                         -> Addr# -- This addr is an array of msghdr-                         -> CUInt -- Length of msghdr array-                         -> MessageFlags 'Receive-                         -> Addr# -- Timeout-                         -> IO CSsize- foreign import ccall unsafe "sys/socket.h accept4"-  c_unsafe_accept4 :: Fd-                   -> MutableByteArray# RealWorld -- SocketAddress-                   -> MutableByteArray# RealWorld -- Ptr CInt-                   -> SocketFlags-                   -> IO Fd+  c_unsafe_accept4 ::+    Fd ->+    MutableByteArray# RealWorld -> -- SocketAddress+    MutableByteArray# RealWorld -> -- Ptr CInt+    SocketFlags ->+    IO Fd  -- Variant of c_unsafe_ptr_accept4 that uses Ptr instead of MutableByteArray. -- Currently, we expect that the two pointers are set to NULL. -- This is only used internally. foreign import ccall unsafe "sys/socket.h accept4"   c_unsafe_ptr_accept4 ::-        Fd-     -> Ptr Void -- SocketAddress-     -> Ptr Void -- Ptr CInt-     -> SocketFlags-     -> IO Fd+    Fd ->+    Ptr Void -> -- SocketAddress+    Ptr Void -> -- Ptr CInt+    SocketFlags ->+    IO Fd -#if defined(UNLIFTEDARRAYFUNCTIONS)-foreign import ccall unsafe "HaskellPosix.h recvmmsg_sockaddr_in"-  c_unsafe_recvmmsg_sockaddr_in ::-       Fd-    -> MutableByteArray# RealWorld -- lengths-    -> MutableByteArray# RealWorld -- sockaddrs-    -> MutableArray# RealWorld (MutableByteArray# RealWorld) -- buffers-    -> CUInt -- Length of msghdr array-    -> MessageFlags 'Receive-    -> IO CInt+{- | Linux extends the @type@ argument of+  <http://man7.org/linux/man-pages/man2/socket.2.html socket> to allow+  setting two socket flags on socket creation: @SOCK_CLOEXEC@ and+  @SOCK_NONBLOCK@. It is advisable to set @SOCK_CLOEXEC@ on when+  opening a socket on linux. For example, we may open a TCP Internet+  socket with: -foreign import ccall unsafe "HaskellPosix.h recvmmsg_sockaddr_discard"-  c_unsafe_recvmmsg_sockaddr_discard ::-       Fd-    -> MutableByteArray# RealWorld -- lengths-    -> MutableArray# RealWorld (MutableByteArray# RealWorld) -- buffers-    -> CUInt -- Length of msghdr array-    -> MessageFlags 'Receive-    -> IO CInt-#endif+  > uninterruptibleSocket internet (applySocketFlags closeOnExec stream) defaultProtocol --- | Linux extends the @type@ argument of---   <http://man7.org/linux/man-pages/man2/socket.2.html socket> to allow---   setting two socket flags on socket creation: @SOCK_CLOEXEC@ and---   @SOCK_NONBLOCK@. It is advisable to set @SOCK_CLOEXEC@ on when---   opening a socket on linux. For example, we may open a TCP Internet---   socket with:------   > uninterruptibleSocket internet (applySocketFlags closeOnExec stream) defaultProtocol------   To additionally open the socket in nonblocking mode---   (e.g. with @SOCK_NONBLOCK@):------   > uninterruptibleSocket internet (applySocketFlags (closeOnExec <> nonblocking) 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) -#if defined(UNLIFTEDARRAYFUNCTIONS)--- | Receive multiple messages. This does not provide the socket---   addresses or the control messages. It does not use any of the---   input-scattering that @recvmmsg@ offers, meaning that a single---   datagram is never split across noncontiguous memory. It supplies---   @NULL@ for the timeout argument. All of the messages must have the---   same maximum size. All resulting byte arrays have been explicitly---   pinned. In addition to bytearrays corresponding to each datagram,---   this also provides the maximum @msg_len@ that @recvmmsg@ wrote---   back out. This is provided so that users of @MSG_TRUNC@ can detect---   when bytes were dropped from the end of a message (although it does---   let the user figure out which message had bytes dropped).-uninterruptibleReceiveMultipleMessageA ::-     Fd -- ^ Socket-  -> CSize -- ^ Maximum bytes per message-  -> CUInt -- ^ Maximum number of messages-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno (CUInt,UnliftedArray ByteArray))-uninterruptibleReceiveMultipleMessageA !s !msgSize !msgCount !flags = do-  placeholder <- PM.newByteArray 0-  bufs <- PM.newUnliftedArray (cuintToInt msgCount) placeholder-  mmsghdrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt LST.sizeofMultipleMessageHeader)-  iovecsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt S.sizeofIOVector)-  let !mmsghdrsAddr@(Addr mmsghdrsAddr#) = ptrToAddr (PM.mutableByteArrayContents mmsghdrsBuf)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeMultipleMessageHeadersWithoutSockAddr bufs iovecsAddr mmsghdrsAddr msgSize msgCount-  r <- c_unsafe_addr_recvmmsg s mmsghdrsAddr# msgCount flags nullAddr#-  if r > (-1)-    then do-      (_,maxMsgSz,frozenBufs) <- shrinkAndFreezeMessages msgSize 0 (cssizeToInt r) bufs mmsghdrsAddr-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray mmsghdrsBuf-      pure (Right (maxMsgSz,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray mmsghdrsBuf-      fmap Left getErrno---- | Receive multiple messages. This is similar to--- @uninterruptibleReceiveMultipleMessageA@. However, it also--- provides the @sockaddr@s of the remote endpoints. These are--- written in contiguous memory to a bytearray of length--- @max_num_msgs * expected_sockaddr_sz@. The @sockaddr@s must--- all be expected to be of the same length. This function--- provides a @sockaddr@ size check that is non-zero when any--- @sockaddr@ had a length other than the expected length.--- This can be used to detect if the @sockaddr@ array has one or--- more corrupt @sockaddr@s in it. All byte arrays returned by--- this function are pinned.------ The values in the returned tuple are:------ * Error-checking number for @sockaddr@ size. Non-zero indicates---   that at least one @sockaddr@ required a number of bytes other---   than the expected number.--- * Pinned bytearray with all of the @sockaddr@s in it as a---   array of structures.--- * The size of the largest message received. If @MSG_TRUNC@ is used---   this lets the caller know if one or more messages were truncated.--- * The message data of each message.------ The @sockaddr@s bytearray and the unlifted array of messages are--- guaranteed to have the same number of elements. -uninterruptibleReceiveMultipleMessageB ::-     Fd -- ^ Socket-  -> CInt -- ^ Expected @sockaddr@ size-  -> CSize -- ^ Maximum bytes per message-  -> CUInt -- ^ Maximum number of messages-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno (CInt,ByteArray,CUInt,UnliftedArray ByteArray))-uninterruptibleReceiveMultipleMessageB !s !expSockAddrSize !msgSize !msgCount !flags = do-  placeholder <- PM.newByteArray 0-  bufs <- PM.newUnliftedArray (cuintToInt msgCount) placeholder-  mmsghdrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt LST.sizeofMultipleMessageHeader)-  iovecsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt S.sizeofIOVector)-  sockaddrsBuf <- PM.newPinnedByteArray (cuintToInt msgCount * cintToInt expSockAddrSize)-  -- Linux does not require zeroing out sockaddr_in before using it,-  -- so we leave sockaddrsBuf alone after initialization.-  let sockaddrsAddr = ptrToAddr (PM.mutableByteArrayContents sockaddrsBuf)-  let !mmsghdrsAddr@(Addr mmsghdrsAddr#) = ptrToAddr (PM.mutableByteArrayContents mmsghdrsBuf)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeMultipleMessageHeadersWithSockAddr bufs iovecsAddr mmsghdrsAddr sockaddrsAddr expSockAddrSize msgSize msgCount-  r <- c_unsafe_addr_recvmmsg s mmsghdrsAddr# msgCount flags nullAddr#-  if r > (-1)-    then do-      (validation,maxMsgSz,frozenBufs) <- shrinkAndFreezeMessages msgSize expSockAddrSize (cssizeToInt r) bufs mmsghdrsAddr-      shrinkMutableByteArray sockaddrsBuf (cssizeToInt r * cintToInt expSockAddrSize)-      sockaddrs <- PM.unsafeFreezeByteArray sockaddrsBuf-      touchMutableByteArray iovecsBuf-      touchMutableByteArray mmsghdrsBuf-      touchMutableByteArray sockaddrsBuf-      pure (Right (validation,sockaddrs,maxMsgSz,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray mmsghdrsBuf-      touchMutableByteArray sockaddrsBuf-      fmap Left getErrno---- | All three buffer arguments need to have the same length (in elements, not bytes).-uninterruptibleReceiveMultipleMessageC ::-     Fd -- ^ Socket-  -> MutablePrimArray RealWorld CInt -- ^ Buffer for payload lengths-  -> MutablePrimArray RealWorld S.SocketAddressInternet -- ^ Buffer for @sockaddr_in@s-  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- ^ Buffers for payloads-  -> CUInt -- ^ Maximum number of datagrams to receive, length of buffers-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CInt)-uninterruptibleReceiveMultipleMessageC !s (MutablePrimArray lens) (MutablePrimArray addrs) (MutableUnliftedArray (MutableUnliftedArray# payloads)) !msgCount !flags =-  c_unsafe_recvmmsg_sockaddr_in s lens addrs payloads msgCount flags >>= errorsFromInt---- | All three buffer arguments need to have the same length (in elements, not bytes).--- This discards the source addresses.-uninterruptibleReceiveMultipleMessageD ::-     Fd -- ^ Socket-  -> MutablePrimArray RealWorld CInt -- ^ Buffer for payload lengths-  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- ^ Buffers for payloads-  -> CUInt -- ^ Maximum number of datagrams to receive, length of buffers-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CInt)-uninterruptibleReceiveMultipleMessageD !s (MutablePrimArray lens) (MutableUnliftedArray (MutableUnliftedArray# payloads)) !msgCount !flags =-  c_unsafe_recvmmsg_sockaddr_discard s lens payloads msgCount flags >>= errorsFromInt---- This sets up an array of mmsghdr. Each msghdr has msg_iov set to--- be an array of iovec with a single element.-initializeMultipleMessageHeadersWithoutSockAddr ::-     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers-  -> Addr -- array of iovec-  -> Addr -- array of message headers-  -> CSize -- message size-  -> CUInt -- message count-  -> IO ()-initializeMultipleMessageHeadersWithoutSockAddr bufs iovecsAddr mmsgHdrsAddr msgSize msgCount =-  let go !ix !iovecAddr !mmsgHdrAddr = if ix < cuintToInt msgCount-        then do-          pokeMultipleMessageHeader mmsgHdrAddr nullAddr 0 iovecAddr 1 nullAddr 0 mempty 0-          initializeIOVector bufs iovecAddr msgSize ix-          go (ix + 1) (plusAddr iovecAddr (cintToInt S.sizeofIOVector)) (plusAddr mmsgHdrAddr (cintToInt LST.sizeofMultipleMessageHeader))-        else pure ()-   in go 0 iovecsAddr mmsgHdrsAddr---- This sets up an array of mmsghdr. Each msghdr has msg_iov set to--- be an array of iovec with a single element. One giant buffer with--- space for all of the @sockaddr@s is used.-initializeMultipleMessageHeadersWithSockAddr ::-     MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> Addr -- array of iovec-  -> Addr -- array of message headers-  -> Addr -- array of sockaddrs-  -> CInt -- expected sockaddr size-  -> CSize -- message size-  -> CUInt -- message count-  -> IO ()-initializeMultipleMessageHeadersWithSockAddr bufs iovecsAddr0 mmsgHdrsAddr0 sockaddrsAddr0 sockaddrSize msgSize msgCount =-  let go !ix !iovecAddr !mmsgHdrAddr !sockaddrAddr = if ix < cuintToInt msgCount-        then do-          pokeMultipleMessageHeader mmsgHdrAddr sockaddrAddr sockaddrSize iovecAddr 1 nullAddr 0 mempty 0-          initializeIOVector bufs iovecAddr msgSize ix-          go (ix + 1)-            (plusAddr iovecAddr (cintToInt S.sizeofIOVector))-            (plusAddr mmsgHdrAddr (cintToInt LST.sizeofMultipleMessageHeader))-            (plusAddr sockaddrAddr (cintToInt sockaddrSize))-        else pure ()-   in go 0 iovecsAddr0 mmsgHdrsAddr0 sockaddrsAddr0--ptrToAddr :: Ptr Word8 -> Addr-ptrToAddr (Ptr x) = Addr x---- Initialize a single iovec. We write the pinned byte array into--- both the iov_base field and into an unlifted array.-initializeIOVector ::-     MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> Addr-  -> CSize-  -> Int-  -> IO ()-initializeIOVector bufs iovecAddr msgSize ix = do-  buf <- PM.newPinnedByteArray (csizeToInt msgSize)-  PM.writeUnliftedArray bufs ix buf-  S.pokeIOVectorBase iovecAddr (ptrToAddr (PM.mutableByteArrayContents buf))-  S.pokeIOVectorLength iovecAddr msgSize---- Freeze a slice of the mutable byte arrays inside the unlifted array,--- shrinking the byte arrays before doing so.-shrinkAndFreezeMessages ::-     CSize -- Full size of each buffer-  -> CInt -- Expected sockaddr size-  -> Int -- Actual number of received messages-  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> Addr -- Array of mmsghdr-  -> IO (CInt,CUInt,UnliftedArray ByteArray)-shrinkAndFreezeMessages !bufSize !expSockAddrSize !n !bufs !mmsghdr0 = do-  r <- PM.unsafeNewUnliftedArray n-  go r 0 0 0 mmsghdr0-  where-  go !r !validation !ix !maxMsgSz !mmsghdr = if ix < n-    then do-      sz <- LST.peekMultipleMessageHeaderLength mmsghdr-      sockaddrSz <- LST.peekMultipleMessageHeaderNameLength mmsghdr-      buf <- PM.readUnliftedArray bufs ix-      when (cuintToInt sz < csizeToInt bufSize) (shrinkMutableByteArray buf (cuintToInt sz))-      PM.writeUnliftedArray r ix =<< PM.unsafeFreezeByteArray buf-      go r (validation .|. (sockaddrSz - expSockAddrSize)) (ix + 1) (max maxMsgSz sz)-        (plusAddr mmsghdr (cintToInt LST.sizeofMultipleMessageHeader))-    else do-      a <- PM.unsafeFreezeUnliftedArray r-      pure (validation,maxMsgSz,a)-#endif--pokeMultipleMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> CUInt -> IO ()-pokeMultipleMessageHeader mmsgHdrAddr a b c d e f g len = do-  LST.pokeMultipleMessageHeaderName mmsgHdrAddr a-  LST.pokeMultipleMessageHeaderNameLength mmsgHdrAddr b-  LST.pokeMultipleMessageHeaderIOVector mmsgHdrAddr c-  LST.pokeMultipleMessageHeaderIOVectorLength mmsgHdrAddr d-  LST.pokeMultipleMessageHeaderControl mmsgHdrAddr e-  LST.pokeMultipleMessageHeaderControlLength mmsgHdrAddr f-  LST.pokeMultipleMessageHeaderFlags mmsgHdrAddr g-  LST.pokeMultipleMessageHeaderLength mmsgHdrAddr len- shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO () shrinkMutableByteArray (MutableByteArray arr) (I# sz) =   PM.primitive_ (shrinkMutableByteArray# arr sz) --- | Variant of 'Posix.Socket.uninterruptibleAccept' that allows setting---   flags on the newly-accepted connection.+{- | Variant of 'Posix.Socket.uninterruptibleAccept' that allows setting+  flags on the newly-accepted connection.+-} uninterruptibleAccept4 ::-     Fd -- ^ Listening socket-  -> CInt -- ^ Maximum socket address size-  -> SocketFlags -- ^ Set non-blocking and close-on-exec without extra syscall-  -> IO (Either Errno (CInt,SocketAddress,Fd)) -- ^ Peer information and connected socket-{-# inline uninterruptibleAccept4 #-}+  -- | Listening socket+  Fd ->+  -- | Maximum socket address size+  CInt ->+  -- | Set non-blocking and close-on-exec without extra syscall+  SocketFlags ->+  -- | Peer information and connected socket+  IO (Either Errno (CInt, SocketAddress, Fd))+{-# INLINE uninterruptibleAccept4 #-} uninterruptibleAccept4 !sock !maxSz !flags = do   sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newByteArray (cintToInt maxSz)   lenBuf@(MutableByteArray lenBuf#) <- PM.newByteArray (PM.sizeOf (undefined :: CInt))@@ -390,16 +131,20 @@         then shrinkMutableByteArray sockAddrBuf (cintToInt sz)         else pure ()       sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf-      pure (Right (sz,SocketAddress sockAddr,r))+      pure (Right (sz, SocketAddress sockAddr, r))     else fmap Left getErrno --- | Variant of 'uninterruptibleAccept4' that requests that the kernel not--- include the socket address in its reponse.+{- | Variant of 'uninterruptibleAccept4' that requests that the kernel not+include the socket address in its reponse.+-} uninterruptibleAccept4_ ::-     Fd -- ^ Listening socket-  -> SocketFlags -- ^ Set non-blocking and close-on-exec without extra syscall-  -> IO (Either Errno Fd) -- ^ Connected socket-{-# inline uninterruptibleAccept4_ #-}+  -- | Listening socket+  Fd ->+  -- | Set non-blocking and close-on-exec without extra syscall+  SocketFlags ->+  -- | Connected socket+  IO (Either Errno Fd)+{-# INLINE uninterruptibleAccept4_ #-} uninterruptibleAccept4_ !sock !flags = do   r <- c_unsafe_ptr_accept4 sock nullPtr nullPtr flags   if r > (-1)@@ -408,32 +153,3 @@  cintToInt :: CInt -> Int cintToInt = fromIntegral--cuintToInt :: CUInt -> Int-cuintToInt = fromIntegral--csizeToInt :: CSize -> Int-csizeToInt = fromIntegral--cssizeToInt :: CSsize -> Int-cssizeToInt = fromIntegral--errorsFromInt :: CInt -> IO (Either Errno CInt)-{-# inline errorsFromInt #-}-errorsFromInt r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno--touchMutableByteArray :: MutableByteArray RealWorld -> IO ()-touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x--touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()-touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)--#if defined(UNLIFTEDARRAYFUNCTIONS)-touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO ()-touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x--touchMutableUnliftedArray# :: MutableUnliftedArray# RealWorld a -> IO ()-touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)-#endif

@@ -75,7 +75,7 @@  -- newtype Collection :: Type -> Type where --   Collection :: !(Ptr a) -> Collection a--- +-- -- indexCollection :: Ptr a --   => Collection a -> Int -> IO (Ptr a) -- indexCollection (Collection p) n = advancePtr p n@@ -88,12 +88,12 @@ --   , controlLength :: !CSize --   , flags :: !(MessageFlags Receive) --   }--- +-- -- data IOVector = IOVector --   { base :: !Addr --   , length :: !CSize --   }--- +-- -- data ControlMessageHeader = ControlMessageHeader --   { length :: !CInt --   , level :: !CInt

@@ -1,18 +1,15 @@-{-# language BangPatterns #-}-{-# language MagicHash #-}-{-# language LambdaCase #-}-{-# language UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE LambdaCase #-}  module Posix.Directory   ( getCurrentWorkingDirectory   ) where  import Data.Primitive (ByteArray)-import GHC.Exts (Ptr(..))+import Foreign.C.Error (Errno, eRANGE, getErrno)+import Foreign.C.Types (CChar, CSize (..)) import Foreign.Ptr (nullPtr)-import Foreign.C.Error (Errno,eRANGE,getErrno)-import Foreign.C.Types (CChar,CSize(..))-import GHC.IO (IO(..))+import GHC.Exts (Ptr (..))  import qualified Data.Primitive as PM import qualified Foreign.Storable as FS@@ -20,11 +17,13 @@ foreign import ccall safe "getcwd"   c_getcwd :: Ptr CChar -> CSize -> IO (Ptr CChar) --- | Get the current working directory without using the system locale---   to convert it to text. This is implemented with a safe FFI call---   since it may block.+{- | Get the current working directory without using the system locale+  to convert it to text. This is implemented with a safe FFI call+  since it may block.+-} getCurrentWorkingDirectory :: IO (Either Errno ByteArray)-getCurrentWorkingDirectory = go (4096 - chunkOverhead) where+getCurrentWorkingDirectory = go (4096 - chunkOverhead)+ where   go !sz = do     -- It may be nice to add a variant of getCurrentWorkingDirectory that     -- allow the user to supply an initial pinned buffer. I'm not sure@@ -59,10 +58,10 @@ -- There must be a null byte present or bad things will happen. -- This will return a nonnegative number. findNullByte :: Ptr CChar -> IO Int-findNullByte = go 0 where+findNullByte = go 0+ where   go :: Int -> Ptr CChar -> IO Int   go !ix !ptr = do     FS.peekElemOff ptr ix >>= \case       0 -> pure ix       _ -> go (ix + 1) ptr-

@@ -1,9 +1,8 @@-{-# language BangPatterns #-}-{-# language BinaryLiterals #-}-{-# language LambdaCase #-}-{-# language MagicHash #-}-{-# language TypeApplications #-}-{-# language UnliftedFFITypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE UnliftedFFITypes #-}  module Posix.File   ( -- * Functions@@ -13,6 +12,7 @@   , uninterruptibleWriteBytes   , uninterruptibleWriteBytesCompletely   , uninterruptibleWriteBytesCompletelyErrno+  , uninterruptibleReadMutableByteArray   , writeBytesCompletelyErrno   , uninterruptibleOpen   , uninterruptibleOpenMode@@ -25,49 +25,53 @@   , uninterruptibleErrorlessClose   , uninterruptibleUnlink   , uninterruptibleLink+     -- * Types-  , AccessMode(..)-  , CreationFlags(..)-  , DescriptorFlags(..)-  , StatusFlags(..)+  , AccessMode (..)+  , CreationFlags (..)+  , DescriptorFlags (..)+  , StatusFlags (..)+     -- * File Descriptor Flags   , Types.nonblocking   , Types.append   , 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,assertMutableByteArrayPinned)-import Data.Bits ((.&.),(.|.))-import Data.Primitive (ByteArray(..))-import Foreign.C.Error (Errno(Errno),getErrno,eOK)-import Foreign.C.String.Managed (ManagedCString(..))-import Foreign.C.Types (CInt(..),CSize(..))-import GHC.Exts (ByteArray#,MutableByteArray#,RealWorld)-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 Data.Primitive (MutableByteArray(MutableByteArray))+import Assertion (assertByteArrayPinned, assertMutableByteArrayPinned)+import Data.Bits ((.&.), (.|.))+import Data.Bytes.Types (Bytes (Bytes))+import Data.Primitive (ByteArray (..), MutableByteArray (MutableByteArray))+import Foreign.C.Error (Errno (Errno), eOK, getErrno)+import Foreign.C.String.Managed (ManagedCString (..))+import Foreign.C.Types (CInt (..), CSize (..))+import GHC.Exts (ByteArray#, MutableByteArray#, RealWorld)+import Posix.File.Types (AccessMode (..), CreationFlags (..), DescriptorFlags (..), StatusFlags (..))+import System.Posix.Types (CMode (..), CSsize (..), Fd (..))  import qualified Posix.File.Types as Types --- | Get file descriptor flags. This uses the unsafe FFI to--- perform @fcntl(fd,F_GETFD)@.+{- | Get file descriptor flags. This uses the unsafe FFI to+perform @fcntl(fd,F_GETFD)@.+-} uninterruptibleGetDescriptorFlags :: Fd -> IO (Either Errno DescriptorFlags) uninterruptibleGetDescriptorFlags !fd = c_getFdFlags fd >>= errorsFromDescriptorFlags --- | Get file status flags. This uses the unsafe FFI to--- perform @fcntl(fd,F_GETFL)@.+{- | Get file status flags. This uses the unsafe FFI to+perform @fcntl(fd,F_GETFL)@.+-} uninterruptibleGetStatusFlags :: Fd -> IO (Either Errno StatusFlags) uninterruptibleGetStatusFlags !fd = c_getFlFlags fd >>= errorsFromStatusFlags @@ -111,183 +115,257 @@   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)+  -- | NULL-terminated file name+  ManagedCString ->+  -- | Access mode+  AccessMode ->+  -- | Creation flags+  CreationFlags ->+  -- | Status flags+  StatusFlags ->+  IO (Either Errno Fd) uninterruptibleOpen (ManagedCString (ByteArray name)) (AccessMode x) (CreationFlags y) (StatusFlags z) =   c_unsafe_open name (x .|. y .|. z) >>= errorsFromFd --- | Variant of 'uninterruptibleOpen' that does not help the caller with--- the types of the flags.+{- | Variant of 'uninterruptibleOpen' that does not help the caller with+the types of the flags.+-} uninterruptibleOpenUntypedFlags ::-     ManagedCString -- ^ NULL-terminated file name-  -> CInt -- ^ Flags-  -> IO (Either Errno Fd)+  -- | NULL-terminated file name+  ManagedCString ->+  -- | Flags+  CInt ->+  IO (Either Errno Fd) uninterruptibleOpenUntypedFlags (ManagedCString (ByteArray name)) x =   c_unsafe_open name x >>= errorsFromFd --- | Variant of 'uninterruptibleOpenMode' that does not help the caller with--- the types of the flags.+{- | Variant of 'uninterruptibleOpenMode' that does not help the caller with+the types of the flags.+-} uninterruptibleOpenModeUntypedFlags ::-     ManagedCString -- ^ NULL-terminated file name-  -> CInt -- ^ Flags-  -> CMode -- ^ Mode-  -> IO (Either Errno Fd)+  -- | NULL-terminated file name+  ManagedCString ->+  -- | Flags+  CInt ->+  -- | Mode+  CMode ->+  IO (Either Errno Fd) uninterruptibleOpenModeUntypedFlags (ManagedCString (ByteArray name)) !x !mode =   c_unsafe_open_mode name x mode >>= 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)+  -- | NULL-terminated file name+  ManagedCString ->+  -- | Access mode, should include @O_CREAT@+  AccessMode ->+  -- | Creation flags+  CreationFlags ->+  -- | Status flags+  StatusFlags ->+  -- | Permissions assigned to newly created file+  CMode ->+  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)-  else fmap Left getErrno+errorsFromDescriptorFlags r@(DescriptorFlags x) =+  if x > (-1)+    then pure (Right r)+    else fmap Left getErrno  errorsFromStatusFlags :: StatusFlags -> IO (Either Errno StatusFlags)-errorsFromStatusFlags r@(StatusFlags x) = if x > (-1)-  then pure (Right r)-  else fmap Left getErrno+errorsFromStatusFlags r@(StatusFlags x) =+  if x > (-1)+    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.+{- | 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 ())+  -- | File descriptor+  Fd ->+  -- | Source bytes+  Bytes ->+  IO (Either Errno ()) uninterruptibleWriteBytesCompletely !fd !b = do   e <- uninterruptibleWriteBytesCompletelyErrno fd b   if e == eOK     then pure (Right ())     else pure (Left e) --- | Variant of 'uninterruptibleWriteBytesCompletely' that uses errno 0--- to communicate success.+{- | Variant of 'uninterruptibleWriteBytesCompletely' that uses errno 0+to communicate success.+-} uninterruptibleWriteBytesCompletelyErrno ::-     Fd -- ^ File descriptor-  -> Bytes -- ^ Source bytes-  -> IO Errno+  -- | File descriptor+  Fd ->+  -- | Source bytes+  Bytes ->+  IO Errno uninterruptibleWriteBytesCompletelyErrno !fd (Bytes (ByteArray buf) off len) =   c_unsafe_bytearray_write_loop fd buf off (fromIntegral @Int @CSize len) --- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.--- The byte array backing the slice must be pinned.+{- | Wrapper for @write(2)@ that takes a slice of bytes and an offset.+The byte array backing the slice must be pinned.+-} writeBytesCompletelyErrno ::-     Fd -- ^ File descriptor-  -> Bytes -- ^ Source bytes-  -> IO Errno+  -- | File descriptor+  Fd ->+  -- | Source bytes+  Bytes ->+  IO Errno writeBytesCompletelyErrno !fd (Bytes buf0 off len) =   let !(ByteArray buf1) = assertByteArrayPinned buf0    in c_safe_bytearray_write_loop fd buf1 off (fromIntegral @Int @CSize len) --- | 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.+{- | 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+  -- | File descriptor+  Fd ->+  -- | Source bytes+  Bytes ->+  -- | Number of bytes written+  IO (Either Errno CSize) 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.+{- | Wrapper for @write(2)@ that takes a byte array and an offset.+The byte array does not need to be pinned.+-} uninterruptibleWriteByteArray ::-     Fd -- ^ Socket-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+  -- | Socket+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize) 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 -- ^ File descriptor-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+  -- | File descriptor+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize) writeByteArray !fd !buf0 !off !len =   let !(ByteArray buf1) = assertByteArrayPinned buf0    in c_safe_bytearray_write fd buf1 off len >>= errorsFromSize  -- writeByteArrayCompletely :: --- | Variant of 'writeByteArray' that operates on mutable byte array.--- Uses @safe@ FFI. The byte array must be pinned.+{- | Variant of 'writeByteArray' that operates on mutable byte array.+Uses @safe@ FFI. The byte array must be pinned.+-} writeMutableByteArray ::-     Fd -- ^ File descriptor-  -> MutableByteArray RealWorld -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer+  -- | File descriptor+  Fd ->+  -- | Source byte array+  MutableByteArray RealWorld ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize) writeMutableByteArray !fd !buf0 !off !len =   let !(MutableByteArray buf1) = assertMutableByteArrayPinned buf0    in c_safe_mutablebytearray_write fd buf1 off len >>= errorsFromSize +uninterruptibleReadMutableByteArray ::+  -- | File descriptor+  Fd ->+  -- | Destination+  MutableByteArray RealWorld ->+  -- | Destination offset+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Number of bytes received+  IO (Either Errno CSize)+uninterruptibleReadMutableByteArray !fd !(MutableByteArray !b) !doff !dlen = do+  c_unsafe_mutable_byte_array_read fd b doff dlen >>= errorsFromSize+ errorsFromSize :: CSsize -> IO (Either Errno CSize)-errorsFromSize r = if r > (-1)-  then pure (Right (cssizeToCSize r))-  else fmap Left getErrno+errorsFromSize r =+  if r > (-1)+    then pure (Right (cssizeToCSize r))+    else fmap Left getErrno  errorsFromFd :: Fd -> IO (Either Errno Fd)-errorsFromFd r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno+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 ())+  -- | Path to existing file+  ManagedCString ->+  -- | Path to new file+  ManagedCString ->+  IO (Either Errno ()) uninterruptibleLink (ManagedCString (ByteArray x)) (ManagedCString (ByteArray y)) =   c_unsafe_link x y >>= errorsFromInt_  uninterruptibleUnlink ::-     ManagedCString -- ^ File name-  -> IO (Either Errno ())+  -- | File name+  ManagedCString ->+  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 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 ())+  -- | Socket+  Fd ->+  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."+{- | 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 ())+  -- | Socket+  Fd ->+  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'.+{- | 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 ()+  -- | Socket+  Fd ->+  IO () uninterruptibleErrorlessClose fd = do   _ <- c_unsafe_close fd   pure ()@@ -309,7 +387,10 @@ -- 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+errorsFromInt_ r =+  if r == 0+    then pure (Right ())+    else fmap Left getErrno +foreign import ccall unsafe "HaskellPosix.h read_offset"+  c_unsafe_mutable_byte_array_read :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> IO CSsize

@@ -1,65 +1,82 @@-{-# language BangPatterns #-}-{-# language MagicHash #-}-{-# language UnboxedTuples #-}-{-# language UnliftedFFITypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+ module Posix.MessageQueue   ( open   , uninterruptibleReceiveByteArray   , uninterruptibleSendBytes+     -- * Types-  , AccessMode(..)-  , CreationFlags(..)-  , StatusFlags(..)+  , AccessMode (..)+  , CreationFlags (..)+  , StatusFlags (..)+     -- * Open Access Mode   , F.readOnly   , F.writeOnly   , F.readWrite+     -- * Open Flags   , F.nonblocking   ) where +import qualified Control.Monad.Primitive as PM import Data.Bits ((.|.))-import GHC.Exts (RealWorld,ByteArray#,MutableByteArray#,Addr#)-import GHC.Exts (Int(I#))-import System.Posix.Types (Fd(..),CSsize(..))-import Foreign.C.Types (CInt(..),CSize(..),CUInt(..))-import Foreign.C.Error (Errno,getErrno)+import Data.Bytes.Types (Bytes (Bytes))+import Data.Primitive (ByteArray (..), MutableByteArray (..))+import qualified Data.Primitive as PM+import Foreign.C.Error (Errno, getErrno) import Foreign.C.String (CString)-import Data.Primitive (MutableByteArray(..),ByteArray(..))-import Data.Bytes.Types (Bytes(Bytes))-import Posix.File.Types (CreationFlags(..),AccessMode(..),StatusFlags(..))+import Foreign.C.Types (CInt (..), CSize (..), CUInt (..))+import GHC.Exts (Addr#, ByteArray#, Int (I#), MutableByteArray#, RealWorld) import qualified GHC.Exts as Exts-import qualified Data.Primitive as PM-import qualified Control.Monad.Primitive as PM+import Posix.File.Types (AccessMode (..), CreationFlags (..), StatusFlags (..)) import qualified Posix.File.Types as F+import System.Posix.Types (CSsize (..), Fd (..))  foreign import ccall unsafe "mqueue.h mq_receive"-  c_unsafe_mq_receive :: Fd -> MutableByteArray# RealWorld-                      -> CSize -> Addr# -> IO CSsize+  c_unsafe_mq_receive ::+    Fd ->+    MutableByteArray# RealWorld ->+    CSize ->+    Addr# ->+    IO CSsize  foreign import ccall unsafe "mqueue.h mq_send_offset"-  c_unsafe_mq_send_offset :: Fd-    -> ByteArray# -> Int -> CSize -> CUInt -> IO CInt+  c_unsafe_mq_send_offset ::+    Fd ->+    ByteArray# ->+    Int ->+    CSize ->+    CUInt ->+    IO CInt  foreign import ccall safe "mqueue.h mq_open"   c_safe_mq_open :: CString -> CInt -> IO Fd  open ::-     CString -- ^ NULL-terminated name of queue, must start with slash-  -> AccessMode -- ^ Access mode-  -> CreationFlags -- ^ Creation flags-  -> StatusFlags -- ^ Status flags-  -> IO (Either Errno Fd)+  -- | NULL-terminated name of queue, must start with slash+  CString ->+  -- | Access mode+  AccessMode ->+  -- | Creation flags+  CreationFlags ->+  -- | Status flags+  StatusFlags ->+  IO (Either Errno Fd) open !name (AccessMode x) (CreationFlags y) (StatusFlags z) =   c_safe_mq_open name (x .|. y .|. z) >>= errorsFromFd  uninterruptibleReceiveByteArray ::-     Fd -- ^ Message queue-  -> CSize -- ^ Maximum length of message-  -> IO (Either Errno ByteArray)+  -- | Message queue+  Fd ->+  -- | Maximum length of message+  CSize ->+  IO (Either Errno ByteArray) uninterruptibleReceiveByteArray !fd !len = do-  m@(MutableByteArray m# ) <- PM.newByteArray (csizeToInt len)-  r <- c_unsafe_mq_receive fd m# len Exts.nullAddr# +  m@(MutableByteArray m#) <- PM.newByteArray (csizeToInt len)+  r <- c_unsafe_mq_receive fd m# len Exts.nullAddr#   case r of     (-1) -> fmap Left getErrno     _ -> do@@ -69,14 +86,17 @@       pure (Right a)  uninterruptibleSendBytes ::-     Fd -- ^ Message queue-  -> Bytes -- ^ Message-  -> CUInt -- ^ Priority-  -> IO (Either Errno ())+  -- | Message queue+  Fd ->+  -- | Message+  Bytes ->+  -- | Priority+  CUInt ->+  IO (Either Errno ()) uninterruptibleSendBytes !fd (Bytes (ByteArray arr) off len) pri =   c_unsafe_mq_send_offset fd arr off (intToCSize len) pri     >>= errorsFromInt_-  + shrinkMutableByteArray :: MutableByteArray RealWorld -> Int -> IO () shrinkMutableByteArray (MutableByteArray arr) (I# sz) =   PM.primitive_ (Exts.shrinkMutableByteArray# arr sz)@@ -94,12 +114,13 @@ -- 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+errorsFromInt_ r =+  if r == 0+    then pure (Right ())+    else fmap Left getErrno  errorsFromFd :: Fd -> IO (Either Errno Fd)-errorsFromFd r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno-+errorsFromFd r =+  if r > (-1)+    then pure (Right r)+    else fmap Left getErrno

@@ -1,13 +1,12 @@-{-# language BangPatterns #-}-{-# language MagicHash #-}-{-# language UnliftedFFITypes #-}-{-# language ScopedTypeVariables #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnliftedFFITypes #-}  module Posix.Poll   ( uninterruptiblePoll   , uninterruptiblePollMutablePrimArray-  , PollFd(..)-  , Exchange(..)+  , PollFd (..)+  , Exchange (..)   , PT.input   , PT.output   , PT.error@@ -16,13 +15,13 @@   , PT.isSubeventOf   ) where -import Posix.Types (CNfds(..))-import Foreign.C.Error (Errno,getErrno)-import Foreign.C.Types (CInt(..))+import Data.Primitive (MutablePrimArray (..))+import Foreign.C.Error (Errno, getErrno)+import Foreign.C.Types (CInt (..))+import GHC.Exts (MutableByteArray#, RealWorld) import GHC.Ptr (Ptr)-import GHC.Exts (RealWorld,MutableByteArray#)-import Posix.Poll.Types (PollFd(..),Exchange(..))-import Data.Primitive (MutablePrimArray(..))+import Posix.Poll.Types (Exchange (..), PollFd (..))+import Posix.Types (CNfds (..))  import qualified Posix.Poll.Types as PT @@ -32,23 +31,25 @@ foreign import ccall unsafe "poll.h poll"   c_poll_prim_array :: MutableByteArray# RealWorld -> CNfds -> CInt -> IO CInt --- | The @timeout@ argument is omitted since it is nonsense to choose---   anything other than 0 when using the unsafe FFI.+{- | The @timeout@ argument is omitted since it is nonsense to choose+  anything other than 0 when using the unsafe FFI.+-} uninterruptiblePoll ::-     Ptr PollFd-  -> CNfds-  -> IO (Either Errno CInt)+  Ptr PollFd ->+  CNfds ->+  IO (Either Errno CInt) uninterruptiblePoll pfds n =   c_poll_ptr pfds n 0 >>= errorsFromInt  uninterruptiblePollMutablePrimArray ::-     MutablePrimArray RealWorld PollFd-  -> CNfds-  -> IO (Either Errno CInt)+  MutablePrimArray RealWorld PollFd ->+  CNfds ->+  IO (Either Errno CInt) uninterruptiblePollMutablePrimArray (MutablePrimArray pfds) n =   c_poll_prim_array pfds n 0 >>= errorsFromInt  errorsFromInt :: CInt -> IO (Either Errno CInt)-errorsFromInt r = if r >= 0-  then pure (Right r)-  else fmap Left getErrno+errorsFromInt r =+  if r >= 0+    then pure (Right r)+    else fmap Left getErrno

@@ -11,7 +11,7 @@ {-# language MagicHash #-} {-# language UnboxedTuples #-} {-# language PolyKinds #-}-{-# language TypeInType #-}+{-# language DataKinds #-}  -- This is needed because hsc2hs does not currently handle ticked -- promoted data constructors correctly.@@ -37,12 +37,10 @@ import Prelude hiding (truncate,error)  import Data.Bits ((.|.),(.&.))-import Data.Word (Word8,Word16,Word32,Word64) import Data.Primitive (Prim(..)) import Foreign.C.Types (CInt(..),CShort) import Foreign.Storable (Storable(..))-import GHC.Ptr (Ptr(..))-import GHC.Exts (RealWorld,Int(I##),Int##,(+##),(*##))+import GHC.Exts (Int(I##),Int##,(+##),(*##)) import System.Posix.Types (Fd(..))  import qualified Data.Kind

@@ -1,5 +1,3 @@ module Posix.Select   (   ) where--

@@ -1,1496 +1,1522 @@-{-# language BangPatterns #-}-{-# language CPP #-}-{-# language DataKinds #-}-{-# language DuplicateRecordFields #-}-{-# language GADTSyntax #-}-{-# language KindSignatures #-}-{-# language LambdaCase #-}-{-# language MagicHash #-}-{-# language NamedFieldPuns #-}-{-# language PatternSynonyms #-}-{-# language ScopedTypeVariables #-}-{-# language UnboxedTuples #-}-{-# language UnliftedFFITypes #-}---- | Types and functions related to the POSIX sockets API.---   Unusual characteristics:------   * Any time the standard calls for @socklen_t@, we use---     @CInt@ instead. Linus Torvalds <https://yarchive.net/comp/linux/socklen_t.html writes>---     that \"Any sane library must have @socklen_t@ be the same size as @int@.---     Anything else breaks any BSD socket layer stuff.\"---   * Send and receive each have several variants. They are distinguished by---     the safe\/unsafe FFI use and by the @Addr@\/@ByteArray@/@MutableByteArray@---     buffer type. They all call @send@ or @recv@ exactly once. They do not---     repeatedly make syscalls like some of the functions in @network@.---     Users who want that behavior need to build on top of this package.---   * 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-    uninterruptibleSocket-    -- ** Socket Pair-  , uninterruptibleSocketPair-    -- ** Address Resolution-  , getAddressInfo-  , uninterruptibleFreeAddressInfo-    -- ** Bind-  , uninterruptibleBind-    -- ** Connect-  , connect-  , uninterruptibleConnect-  , uninterruptibleConnectPtr-    -- ** Listen-  , uninterruptibleListen-    -- ** Accept-  , accept-  , uninterruptibleAccept-  , accept_-    -- ** Get Socket Name-  , uninterruptibleGetSocketName-    -- ** Get Socket Option-  , uninterruptibleGetSocketOption-    -- ** Set Socket Option-  , uninterruptibleSetSocketOption-  , uninterruptibleSetSocketOptionByteArray-  , uninterruptibleSetSocketOptionInt-    -- ** Close-  , F.close-  , F.uninterruptibleClose-  , F.uninterruptibleErrorlessClose-    -- ** Shutdown-  , uninterruptibleShutdown-    -- ** Send-  , send-  , sendByteArray-  , sendMutableByteArray-  , uninterruptibleSend-  , uninterruptibleSendByteArray-  , uninterruptibleSendMutableByteArray-    -- ** Send To-  , uninterruptibleSendToByteArray-  , uninterruptibleSendToMutableByteArray-  , uninterruptibleSendToInternet-  , uninterruptibleSendToInternetByteArray-  , uninterruptibleSendToInternetMutableByteArray-    -- ** Write Vector-#if defined(UNLIFTEDARRAYFUNCTIONS)-  , writeVector-#endif-    -- ** Receive-  , receive-  , receiveByteArray-  , uninterruptibleReceive-  , uninterruptibleReceiveMutableByteArray-    -- ** Receive From-  , uninterruptibleReceiveFromMutableByteArray-  , uninterruptibleReceiveFromMutableByteArray_-  , uninterruptibleReceiveFrom_-  , uninterruptibleReceiveFromInternet-  , uninterruptibleReceiveFromInternetMutableByteArray-    -- ** Receive Message-    -- $receiveMessage-#if defined(UNLIFTEDARRAYFUNCTIONS)-  , uninterruptibleReceiveMessageA-  , uninterruptibleReceiveMessageB-#endif-    -- ** Send Message-  , uninterruptibleSendMessageA-  , uninterruptibleSendMessageB-#if defined(UNLIFTEDARRAYFUNCTIONS)-  , uninterruptibleSendByteArrays-#endif-    -- ** Byte-Order Conversion-    -- $conversion-  , hostToNetworkLong-  , hostToNetworkShort-  , networkToHostLong-  , networkToHostShort-    -- * Types-  , Family(..)-  , Type(..)-  , Protocol(..)-  , OptionName(..)-  , OptionValue(..)-  , Level(..)-  , Message(..)-  , MessageFlags(..)-  , ShutdownType(..)-  , AddressInfo-    -- * Socket Address-    -- ** Types-  , SocketAddress(..)-  , PST.SocketAddressInternet(..)-  , PST.SocketAddressUnix(..)-    -- ** Encoding-  , PSP.encodeSocketAddressInternet-  , PSP.encodeSocketAddressUnix-    -- ** Decoding-  , PSP.decodeSocketAddressInternet-  , PSP.indexSocketAddressInternet-    -- ** Sizes-  , PSP.sizeofSocketAddressInternet-    -- * Data Construction-    -- ** Socket Domains-  , pattern PST.Unix-  , pattern PST.Unspecified-  , pattern PST.Internet-  , pattern PST.Internet6-    -- ** Socket Types-  , PST.stream-  , PST.datagram-  , PST.raw-  , PST.sequencedPacket-    -- ** Protocols-  , PST.defaultProtocol-  , PST.rawProtocol-  , PST.icmp-  , PST.tcp-  , PST.udp-  , PST.ip-  , PST.ipv6-    -- ** Receive Flags-  , PST.peek-  , PST.outOfBand-  , PST.waitAll-    -- ** Send Flags-  , PST.noSignal-    -- ** Shutdown Types-  , PST.read-  , PST.write-  , PST.readWrite-    -- ** Socket Levels-  , 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-  , PST.pokeMessageHeaderIOVector-  , PST.pokeMessageHeaderIOVectorLength-  , PST.pokeMessageHeaderControl-  , PST.pokeMessageHeaderControlLength-  , PST.pokeMessageHeaderFlags-    -- *** Metadata-  , PST.sizeofMessageHeader-    -- ** IO Vector-    -- *** Peek-  , PST.peekIOVectorBase-  , PST.peekIOVectorLength-    -- *** Poke-  , PST.pokeIOVectorBase-  , PST.pokeIOVectorLength-    -- *** Metadata-  , PST.sizeofIOVector-  ) where--import GHC.ByteOrder (ByteOrder(BigEndian,LittleEndian),targetByteOrder)-import GHC.IO (IO(..))-import Data.Primitive.Addr (Addr(..),plusAddr,nullAddr)-import Data.Primitive (MutablePrimArray(..),MutableByteArray(..),ByteArray(..))--#if defined(UNLIFTEDARRAYFUNCTIONS)-import Data.Primitive.Unlifted.Array (MutableUnliftedArray,UnliftedArray,UnliftedArray_(UnliftedArray))-import Data.Primitive.Unlifted.Array (MutableUnliftedArray_(MutableUnliftedArray))-import Data.Primitive.Unlifted.Array.Primops (UnliftedArray#(UnliftedArray#),MutableUnliftedArray#)-#endif--import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset(..))-import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset(..))-import Data.Word (Word8,Word16,Word32,byteSwap16,byteSwap32)-import Data.Void (Void)-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(Ptr),RealWorld,ByteArray#,MutableByteArray#)-import GHC.Exts (Addr#,TYPE)-import GHC.Exts (Int(I#))-import GHC.Exts (shrinkMutableByteArray#,touch#)-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(..))--#if MIN_VERSION_base(4,16,0)-import GHC.Exts (RuntimeRep(BoxedRep),Levity(Unlifted))-#else-import GHC.Exts (RuntimeRep(UnliftedRep))-#endif--import qualified Posix.File as F-import qualified Posix.Socket.Types as PST-import qualified Data.Primitive as PM-#if defined(UNLIFTEDARRAYFUNCTIONS)-import qualified Data.Primitive.Unlifted.Array as PM-#endif-import qualified Control.Monad.Primitive as PM-import qualified GHC.Exts as Exts---- This module include operating-system specific code used--- to serialize some of various kind of socket address types.-import qualified Posix.Socket.Platform as PSP---- 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 :: Family -> Type -> Protocol -> IO Fd--foreign import ccall unsafe "sys/socket.h socketpair"-  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 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--- CInt rather than introducing a type corresponding to socklen_t.--- According to Linus Torvalds, "Any sane library must have socklen_t--- be the same size as int. Anything else breaks any BSD socket layer stuff."--- (https://yarchive.net/comp/linux/socklen_t.html). If a platform--- violates this assumption, this wrapper will be broken on that platform.-foreign import ccall unsafe "sys/socket.h bind"-  c_bind :: Fd -> ByteArray# -> CInt -> IO CInt---- Per the spec, the type signature of accept is:---   int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);--- The restrict keyword does not matter much for our purposes. See the--- note on c_bind for why we use CInt for socklen_t. Remember that the--- first bytearray argument is actually SocketAddress in the function that--- wraps this one. The second bytearray argument is a pointer to the size.-foreign import ccall safe "sys/socket.h accept"-  c_safe_accept :: Fd-                -> MutableByteArray# RealWorld -- SocketAddress-                -> MutableByteArray# RealWorld -- Ptr CInt-                -> IO Fd-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--foreign import ccall unsafe "sys/socket.h setsockopt_int"-  c_unsafe_setsockopt_int :: Fd-                          -> Level-                          -> OptionName-                          -> 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.-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-foreign import ccall unsafe "sys/socket.h connect"-  c_unsafe_connect_addr :: Fd -> Addr# -> CInt -> IO CInt---- There are several options for wrapping send. Both safe and unsafe--- are useful. Additionally, in the unsafe category, we also--- have the option of writing to either an address or a byte array.--- Unsafe FFI calls guarantee that byte arrays will not be relocated--- while the FFI call is taking place. Safe FFI calls do not have--- this guarantee, so internally we must be careful when using these to only--- provide pinned byte arrays as arguments.-foreign import ccall 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# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize-foreign import ccall safe "sys/socket.h send_offset"-  c_safe_mutablebytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> 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 -> MessageFlags 'Send -> IO CSsize-foreign import ccall unsafe "sys/socket.h send_offset"-  c_unsafe_bytearray_send :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize-foreign import ccall unsafe "sys/socket.h send_offset"-  c_unsafe_mutable_bytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> 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# -> Int -> 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 -> Int -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize-foreign import ccall unsafe "sys/socket.h sendto_inet_offset"-  c_unsafe_mutable_bytearray_sendto_inet :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize-foreign import ccall unsafe "HaskellPosix.h sendto_inet_offset"-  c_unsafe_bytearray_sendto_inet :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize-foreign import ccall unsafe "HaskellPosix.h sendto_inet_addr"-  c_unsafe_addr_sendto_inet :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize--foreign import ccall unsafe "HaskellPosix.h sendmsg_a"-  c_unsafe_sendmsg_a :: Fd -> Addr# -> CSize -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> IO CSsize--foreign import ccall unsafe "HaskellPosix.h sendmsg_b"-  c_unsafe_sendmsg_b :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize--#if defined(UNLIFTEDARRAYFUNCTIONS)-foreign import ccall unsafe "HaskellPosix.h sendmsg_bytearrays"-  c_unsafe_sendmsg_bytearrays :: Fd -> UnliftedArray# ByteArray# -> Int -> Int -> Int -> MessageFlags 'Send -> IO CSsize-#endif--foreign import ccall safe "sys/uio.h writev"-  c_safe_writev :: Fd -> MutableByteArray# RealWorld -> CInt -> IO CSsize---- There are several ways to wrap recv.-foreign import ccall safe "sys/socket.h recv"-  c_safe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize-foreign import ccall unsafe "sys/socket.h recv"-  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 -> Int -> 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 -> Int -> CSize -> MessageFlags 'Receive -> MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> IO CSsize-foreign import ccall unsafe "sys/socket.h recvfrom_offset_peerless"-  c_unsafe_mutable_byte_array_peerless_recvfrom ::-       Fd-    -> MutableByteArray# RealWorld -> Int -> CSize-    -> MessageFlags 'Receive -> IO CSsize-foreign import ccall unsafe "sys/socket.h recvfrom_addr_peerless"-  c_unsafe_addr_peerless_recvfrom ::-       Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize-foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet"-  c_unsafe_recvfrom_inet ::-       Fd-    -> MutableByteArray# RealWorld-    -> Int-    -> CSize-    -> MessageFlags 'Receive-    -> MutableByteArray# RealWorld-    -> Int-    -> IO CSsize-foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet_addr"-  c_unsafe_recvfrom_inet_addr ::-       Fd-    -> Addr#-    -> CSize-    -> MessageFlags 'Receive-    -> MutableByteArray# RealWorld-    -> Int-    -> IO CSsize--foreign import ccall unsafe "sys/socket.h recvmsg"-  c_unsafe_addr_recvmsg :: Fd-                        -> Addr# -- This addr is a pointer to msghdr-                        -> MessageFlags 'Receive-                        -> IO CSsize---- | Create an endpoint for communication, returning a file---   descriptor that refers to that endpoint. The---   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/socket.html POSIX specification>---   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 ::-     Family -- ^ Communications domain (e.g. 'internet', 'unix')-  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags-  -> Protocol -- ^ Protocol-  -> IO (Either Errno Fd)-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. No special preparation is required before calling---   this function. The author believes that it cannot block for a prolonged---   period of time.-uninterruptibleSocketPair ::-     Family -- ^ Communications domain (probably 'unix')-  -> Type -- ^ Socket type (e.g. 'datagram', 'stream') with flags-  -> Protocol -- ^ Protocol-  -> IO (Either Errno (Fd,Fd))-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-  r <- c_socketpair dom typ prot sockets#-  if r == 0-    then do-      fd1 <- PM.readPrimArray sockets 0-      fd2 <- PM.readPrimArray sockets 1-      pure (Right (fd1,fd2))-    else fmap Left getErrno----- | 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>---   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. 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 ())-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. 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 ())-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.-connect ::-     Fd -- ^ Fd-  -> SocketAddress -- ^ Socket address, extensible tagged union-  -> IO (Either Errno ())-connect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =-  case 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_--uninterruptibleConnectPtr ::-     Fd -- ^ Fd-  -> Ptr a -- ^ Socket address-  -> Int -- ^ Size of socket address-  -> IO (Either Errno ())-uninterruptibleConnectPtr !fd (Ptr sockAddr#) !sz =-  c_unsafe_connect_addr fd sockAddr# (intToCInt sz) >>= errorsFromInt_---- | Extract the first connection on the queue of pending connections. The---   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>---   includes more details. This function\'s type differs slightly from---   the specification:------   > int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);------   Instead of requiring the caller to prepare buffers through which---   information is returned, this haskell binding to @accept@ prepares---   those buffers internally. This eschews C\'s characteristic buffer-passing---   in favor of the Haskell convention of allocating internally and returning.------   More specifically, this binding lacks an argument corresponding to the---   @sockaddr@ buffer from the specification. That mutable buffer is allocated---   internally, resized and frozen upon a success, and returned along with---   the file descriptor of the accepted socket. The size of this buffer is---   determined by the second argument (maximum socket address size). This---   size argument is also writen to the @address_len@ buffer, which is also---   allocated internally. The size returned through this pointer is used to---   resize the @sockaddr@ buffer, which is then frozen so that an immutable---   'SocketAddress' is returned to the end user.------   For applications uninterested in the peer (described by @sockaddr@),---   POSIX @accept@ allows the null pointer to be passed as both @address@ and---   @address_len@. This behavior is provided by 'accept_'.-accept ::-     Fd -- ^ Listening socket-  -> CInt -- ^ Maximum socket address size-  -> IO (Either Errno (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-  r <- c_safe_accept sock sockAddrBuf# lenBuf#-  if r > (-1)-    then do-      (sz :: CInt) <- PM.readByteArray lenBuf 0-      -- 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-      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_ ::-     Fd -- ^ Listening socket-  -> IO (Either Errno Fd) -- ^ Connected socket-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---- | Set the value for the option specified by the 'Option' argument for---   the socket specified by the 'Fd' argument. The---   <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>---   of @getsockopt@ includes more details. This variant requires that the---   size of the @option_value@---   be the same as the size of 'CInt'. That is, the @option_name@ must---   describe an option that is represented by a C integer. This is a---   common case, so we avoid allocations by reference-passing in C.-uninterruptibleSetSocketOptionInt ::-     Fd -- ^ Socket-  -> Level -- ^ Socket level-  -> OptionName -- ^ Option name-  -> CInt -- ^ Option value-  -> IO (Either Errno ())-uninterruptibleSetSocketOptionInt sock level optName optValue =-  c_unsafe_setsockopt_int sock level optName optValue >>= errorsFromInt_---- | 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---   FFI, it allocates a pinned copy of the bytearry if it was not---   already pinned.-sendByteArray ::-     Fd -- ^ Socket-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-sendByteArray fd b@(ByteArray b#) off len flags = if isByteArrayPinned b-  then errorsFromSize =<< c_safe_bytearray_send fd b# off len flags-  else do-    x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)-    PM.copyByteArray x off b 0 (csizeToInt len)-    errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags--#if MIN_VERSION_base(4,16,0)-data UList (a :: TYPE ('BoxedRep 'Unlifted)) where-#else-data UList (a :: TYPE 'UnliftedRep) where-#endif-  UNil :: UList a-  UCons :: a -> UList a -> UList a---- Internal function. Fold with strict accumulator. Upper bound is exclusive.--- Hits every int in the range [0,hi) from highest to lowest.-foldDownward :: forall a. Int -> a -> (a -> Int -> IO a) -> IO a-{-# INLINE foldDownward #-}-foldDownward !hi !a0 f = go (hi - 1) a0 where-  go :: Int -> a -> IO a-  go !ix !a = if ix >= 0-    then f a ix >>= go (ix - 1)-    else pure a---- | Copy and pin a byte array if, it's not already pinned.-pinByteArray :: ByteArray -> IO (Maybe ByteArray)-{-# INLINE pinByteArray #-}-pinByteArray byteArray =-  if isByteArrayPinned byteArray-    then-      pure Nothing-    else do-      pinnedByteArray <- PM.newPinnedByteArray len-      PM.copyByteArray pinnedByteArray 0 byteArray 0 len-      r <- PM.unsafeFreezeByteArray pinnedByteArray-      pure (Just r)-  where-    len = PM.sizeofByteArray byteArray---- | Send two payloads (one from unmanaged memory and one from--- managed memory) over a network socket.-uninterruptibleSendMessageA ::-     Fd -- ^ Socket-  -> Addr -- ^ Source address (payload A)-  -> CSize -- ^ Length in bytes (payload A)-  -> MutableByteArrayOffset RealWorld -- ^ Source and offset (payload B)-  -> CSize -- ^ Length in bytes (payload B)-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-uninterruptibleSendMessageA fd (Addr addr) lenA-  (MutableByteArrayOffset{array,offset}) lenB flags =-    c_unsafe_sendmsg_a fd addr lenA (unMba array) offset lenB flags-      >>= errorsFromSize---- | Send two payloads (one from managed memory and one from--- unmanaged memory) over a network socket.-uninterruptibleSendMessageB ::-     Fd -- ^ Socket-  -> MutableByteArrayOffset RealWorld -- ^ Source and offset (payload B)-  -> CSize -- ^ Length in bytes (payload B)-  -> Addr -- ^ Source address (payload A)-  -> CSize -- ^ Length in bytes (payload A)-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-uninterruptibleSendMessageB fd -  (MutableByteArrayOffset{array,offset}) lenB-  (Addr addr) lenA flags =-    c_unsafe_sendmsg_b fd (unMba array) offset lenB addr lenA flags-      >>= errorsFromSize---- | 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---   FFI, it allocates a pinned copy of the bytearry if it was not---   already pinned.-sendMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-sendMutableByteArray fd b@(MutableByteArray b#) off len flags = if isMutableByteArrayPinned b-  then errorsFromSize =<< c_safe_mutablebytearray_send fd b# off len flags-  else do-    x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)-    PM.copyMutableByteArray x off b 0 (csizeToInt len)-    errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags---- | Send data from an address over a network socket. This is not guaranteed---   to send the entire length. This uses the safe FFI since---   it may block indefinitely.-send ::-     Fd -- ^ Connected socket-  -> Addr -- ^ Source address-  -> CSize -- ^ Length in bytes-  -> 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---- | Send data from an address over a network socket. This uses the unsafe FFI.---   Users of this function should be sure to set flags that prohibit this---   from blocking. On Linux this is accomplished with @O_NONBLOCK@. It is---   often desirable to call 'threadWaitWrite' on a nonblocking socket before---   calling @unsafeSend@ on it.-uninterruptibleSend ::-     Fd -- ^ Socket-  -> Addr -- ^ Source address-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-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.-uninterruptibleSendByteArray ::-     Fd -- ^ Socket-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-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.-uninterruptibleSendMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Source mutable byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-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.---   This uses the unsafe FFI; considerations pertaining to 'sendToUnsafe'---   apply to this function as well. The offset and length arguments---   cause a slice of the byte array to be sent rather than the entire---   byte array.-uninterruptibleSendToByteArray ::-     Fd -- ^ Socket-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> SocketAddress -- ^ Socket Address-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-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---- | Variant of 'uninterruptibleSendToByteArray' that requires---   that @sockaddr_in@ be used as the socket address. This is used to---   avoid allocating a buffer for the socket address when the caller---   knows in advance that they are sending to an IPv4 address.-uninterruptibleSendToInternetByteArray ::-     Fd -- ^ Socket-  -> ByteArray -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> SocketAddressInternet -- ^ Socket Address-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-uninterruptibleSendToInternetByteArray fd (ByteArray b) off len flags (SocketAddressInternet{port,address}) =-  c_unsafe_bytearray_sendto_inet fd b off len flags port address >>= errorsFromSize---- | Variant of 'uninterruptibleSendToByteArray' that requires---   that @sockaddr_in@ be used as the socket address. This is used to---   avoid allocating a buffer for the socket address when the caller---   knows in advance that they are sending to an IPv4 address.-uninterruptibleSendToInternet ::-     Fd -- ^ Socket-  -> Addr -- ^ Source byte array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> SocketAddressInternet -- ^ Socket Address-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-uninterruptibleSendToInternet fd (Addr b) len flags (SocketAddressInternet{port,address}) =-  c_unsafe_addr_sendto_inet fd b len flags port address >>= errorsFromSize---- | Send data from a mutable byte array over an unconnected network socket.---   This uses the unsafe FFI; concerns pertaining to 'uninterruptibleSend'---   apply to this function as well. The offset and length arguments---   cause a slice of the mutable byte array to be sent rather than the entire---   byte array.-uninterruptibleSendToMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> SocketAddress -- ^ Socket Address-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-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---- | Variant of 'uninterruptibleSendToMutableByteArray' that requires---   that @sockaddr_in@ be used as the socket address. This is used to---   avoid allocating a buffer for the socket address when the caller---   knows in advance that they are sending to an IPv4 address.-uninterruptibleSendToInternetMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Source byte array-  -> Int -- ^ Offset into source array-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Send -- ^ Flags-  -> SocketAddressInternet -- ^ Socket Address-  -> IO (Either Errno CSize) -- ^ Number of bytes pushed to send buffer-uninterruptibleSendToInternetMutableByteArray fd (MutableByteArray b) off len flags (SocketAddressInternet{port,address}) =-  c_unsafe_mutable_bytearray_sendto_inet fd b off len flags port address >>= errorsFromSize---- | Receive data into an address from a network socket. This wraps @recv@ using---   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-  -> 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 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-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno ByteArray)-receiveByteArray !fd !len !flags = do-  m <- PM.newPinnedByteArray (csizeToInt len)-  let !(Addr addr) = ptrToAddr (PM.mutableByteArrayContents m)-  r <- c_safe_addr_recv fd addr len flags-  if r /= (-1)-    then do-      -- Why copy when we could just shrink? We want to always return-      -- byte arrays that are not explicitly pinned.-      let sz = cssizeToInt r-      x <- PM.newByteArray sz-      PM.copyMutableByteArray x 0 m 0 sz-      a <- PM.unsafeFreezeByteArray x-      pure (Right a)-    else fmap Left getErrno---- | Receive data into an address from a network socket. This wraps @recv@---   using the unsafe FFI. Users of this function should be sure to set flags---   that prohibit this from blocking. On Linux this is accomplished by setting---   the @MSG_DONTWAIT@ flag and handling the resulting @EAGAIN@ or---   @EWOULDBLOCK@. When the returned size is zero, there are no additional---   bytes to receive and the peer has performed an orderly shutdown.-uninterruptibleReceive ::-     Fd -- ^ Socket-  -> Addr -- ^ Source address-  -> CSize -- ^ Length in bytes-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CSize)-{-# inline uninterruptibleReceive #-}-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.-uninterruptibleReceiveMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Destination byte array-  -> Int -- ^ Destination offset-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Bytes received into array-{-# inline uninterruptibleReceiveMutableByteArray #-}-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. This function does not resize the buffer.-uninterruptibleReceiveFromMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Destination byte array-  -> Int -- ^ Destination offset-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> CInt -- ^ Maximum socket address size-  -> 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-  -- TODO: We currently allocate one buffer for the size and-  -- one for the peer. We could improve this by allocating-  -- a single buffer instead. We would need to add some-  -- cleverness in the cbits directory.-  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-      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--uninterruptibleReceiveFromInternet ::-     Fd -- ^ Socket-  -> Addr -- ^ Destination byte array-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> MutablePrimArrayOffset RealWorld SocketAddressInternet -- ^ Address-  -> IO (Either Errno CSize) -- ^ Number of bytes received into array-{-# inline uninterruptibleReceiveFromInternet #-}-uninterruptibleReceiveFromInternet !fd-  (Addr b) !len !flags-  (MutablePrimArrayOffset (MutablePrimArray sockAddrBuf) addrOff) =-    c_unsafe_recvfrom_inet_addr fd b len flags sockAddrBuf addrOff-    >>= errorsFromSize--uninterruptibleReceiveFromInternetMutableByteArray ::-     Fd -- ^ Socket-  -> MutableByteArrayOffset RealWorld -- ^ Destination byte array-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> MutablePrimArrayOffset RealWorld SocketAddressInternet -- ^ Address-  -> IO (Either Errno CSize) -- ^ Number of bytes received into array-{-# inline uninterruptibleReceiveFromInternetMutableByteArray #-}-uninterruptibleReceiveFromInternetMutableByteArray !fd-  (MutableByteArrayOffset (MutableByteArray b) off) !len !flags-  (MutablePrimArrayOffset (MutablePrimArray sockAddrBuf) addrOff) =-    c_unsafe_recvfrom_inet fd b off len flags sockAddrBuf addrOff-    >>= errorsFromSize---- | 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.-uninterruptibleReceiveFromMutableByteArray_ ::-     Fd -- ^ Socket-  -> MutableByteArray RealWorld -- ^ Destination byte array-  -> Int -- ^ Destination offset-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes received into array-{-# inline uninterruptibleReceiveFromMutableByteArray_ #-}-uninterruptibleReceiveFromMutableByteArray_ !fd (MutableByteArray !b) !off !len !flags =-  c_unsafe_mutable_byte_array_peerless_recvfrom fd b off len flags-    >>= errorsFromSize---- | 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.-uninterruptibleReceiveFrom_ ::-     Fd -- ^ Socket-  -> Addr -- ^ Destination byte array-  -> CSize -- ^ Maximum bytes to receive-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno CSize) -- ^ Number of bytes received into array-{-# inline uninterruptibleReceiveFrom_ #-}-uninterruptibleReceiveFrom_ !fd (Addr !b) !len !flags =-  c_unsafe_addr_peerless_recvfrom fd b len flags-    >>= errorsFromSize--ptrToAddr :: Ptr Word8 -> Addr-ptrToAddr (Exts.Ptr a) = Addr a---- | 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))-  else fmap Left getErrno--errorsFromFd :: Fd -> IO (Either Errno Fd)-errorsFromFd r = if r > (-1)-  then pure (Right r)-  else fmap Left getErrno---- Sometimes, functions that return an int use zero to indicate--- success and negative one to indicate failure without including--- additional information in the value.-errorsFromInt_ :: CInt -> IO (Either Errno ())-errorsFromInt_ r = if r == 0-  then pure (Right ())-  else fmap Left getErrno--intToCInt :: Int -> CInt-intToCInt = fromIntegral--intToCSize :: Int -> CSize-intToCSize = fromIntegral--cintToInt :: CInt -> Int-cintToInt = fromIntegral--csizeToInt :: CSize -> Int-csizeToInt = fromIntegral--cssizeToInt :: CSsize -> Int-cssizeToInt = fromIntegral---- only call this when it is known that the argument is non-negative-cssizeToCSize :: CSsize -> CSize-cssizeToCSize = fromIntegral--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--pokeMessageHeader :: Addr -> Addr -> CInt -> Addr -> CSize -> Addr -> CSize -> MessageFlags 'Receive -> IO ()-pokeMessageHeader msgHdrAddr a b c d e f g = do-  PST.pokeMessageHeaderName msgHdrAddr a-  PST.pokeMessageHeaderNameLength msgHdrAddr b-  PST.pokeMessageHeaderIOVector msgHdrAddr c-  PST.pokeMessageHeaderIOVectorLength msgHdrAddr d-  PST.pokeMessageHeaderControl msgHdrAddr e-  PST.pokeMessageHeaderControlLength msgHdrAddr f-  PST.pokeMessageHeaderFlags msgHdrAddr g--#if defined(UNLIFTEDARRAYFUNCTIONS)--- | Write data from multiple byte arrays to the file/socket associated---   with the file descriptor. This does not support slicing. The---   <http://pubs.opengroup.org/onlinepubs/009604499/functions/writev.html POSIX specification>---   of @writev@ includes more details.-writeVector ::-     Fd -- ^ Socket-  -> UnliftedArray ByteArray -- ^ Source byte arrays-  -> IO (Either Errno CSize)-writeVector fd buffers = do-  iovecs@(MutableByteArray iovecs#) :: MutableByteArray RealWorld <--    PM.newPinnedByteArray-      (cintToInt PST.sizeofIOVector * PM.sizeofUnliftedArray buffers)-  -- We construct a list of the new buffers for the sole purpose-  -- of ensuring that we can touch the list later to keep all-  -- the new buffers live.-  newBufs <- foldDownward (PM.sizeofUnliftedArray buffers) UNil $ \newBufs i -> do-    let !buf = PM.indexUnliftedArray buffers i-    pinByteArray buf >>= \case-      Nothing -> do-        let buffer = buf-        let targetAddr :: Addr-            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`-              (i * cintToInt PST.sizeofIOVector)-        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))-        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))-        pure newBufs-      Just buffer -> do-        let targetAddr :: Addr-            targetAddr = ptrToAddr (PM.mutableByteArrayContents iovecs) `plusAddr`-              (i * cintToInt PST.sizeofIOVector)-        PST.pokeIOVectorBase targetAddr (ptrToAddr (PM.byteArrayContents buffer))-        PST.pokeIOVectorLength targetAddr (intToCSize (PM.sizeofByteArray buffer))-        pure (UCons (unByteArray buffer) newBufs)-  r <- errorsFromSize =<<-    c_safe_writev fd iovecs# (intToCInt (PM.sizeofUnliftedArray buffers))-  -- Touching both the unlifted array and the list of new buffers-  -- here is crucial to ensuring that-  -- the buffers do not get GCed before c_safe_writev. Just touching-  -- them should keep all of their children alive too.-  touchUnliftedArray buffers-  touchLifted newBufs-  pure r---- | Send many immutable byte arrays with @sendmsg@.--- This accepts a slice into the chunks. Additionally,--- this accepts an offset into the first chunk.-uninterruptibleSendByteArrays ::-     Fd -- ^ Socket-  -> UnliftedArray ByteArray -- ^ Byte arrays-  -> Int -- ^ Offset into byte array chunks-  -> Int -- ^ Number of chunks to send-  -> Int -- ^ Offset into first chunk-  -> MessageFlags 'Send-  -> IO (Either Errno CSize)-{-# inline uninterruptibleSendByteArrays #-}-uninterruptibleSendByteArrays !fd (UnliftedArray arrs)-  off !len !offC !flags =-    c_unsafe_sendmsg_bytearrays fd arrs off len offC flags-      >>= errorsFromSize---- | Receive a message, scattering the input. This does not provide---   the socket address or the control messages. All of the chunks---   must have the same maximum size. All resulting byte arrays have---   been explicitly pinned.-uninterruptibleReceiveMessageA ::-     Fd -- ^ Socket-  -> CSize -- ^ Maximum bytes per chunk-  -> CSize -- ^ Maximum number of chunks-  -> MessageFlags 'Receive -- ^ Flags-  -> IO (Either Errno (CSize,UnliftedArray ByteArray))-uninterruptibleReceiveMessageA !s !chunkSize !chunkCount !flags = do-  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)-  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeIOVectors bufs iovecsAddr chunkSize chunkCount-  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)-  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)-  pokeMessageHeader msgHdrAddr nullAddr 0 iovecsAddr chunkCount nullAddr 0 flags-  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags-  if r > (-1)-    then do-      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs-      frozenBufs <- deepFreezeIOVectors filled bufs-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      pure (Right (cssizeToCSize r,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      fmap Left getErrno---- | Receive a message, scattering the input. This provides the socket---   address but does not include control messages. All of the chunks---   must have the same maximum size. All resulting byte arrays have---   been explicitly pinned.-uninterruptibleReceiveMessageB ::-     Fd -- ^ Socket-  -> CSize -- ^ Maximum bytes per chunk-  -> CSize -- ^ Maximum number of chunks-  -> MessageFlags 'Receive -- ^ Flags-  -> CInt -- ^ Maximum socket address size-  -> IO (Either Errno (CInt,SocketAddress,CSize,UnliftedArray ByteArray))-uninterruptibleReceiveMessageB !s !chunkSize !chunkCount !flags !maxSockAddrSz = do-  sockAddrBuf <- PM.newPinnedByteArray (cintToInt maxSockAddrSz)-  bufs <- PM.unsafeNewUnliftedArray (csizeToInt chunkCount)-  iovecsBuf <- PM.newPinnedByteArray (csizeToInt chunkCount * cintToInt PST.sizeofIOVector)-  let iovecsAddr = ptrToAddr (PM.mutableByteArrayContents iovecsBuf)-  initializeIOVectors bufs iovecsAddr chunkSize chunkCount-  msgHdrBuf <- PM.newPinnedByteArray (cintToInt PST.sizeofMessageHeader)-  let !msgHdrAddr@(Addr msgHdrAddr#) = ptrToAddr (PM.mutableByteArrayContents msgHdrBuf)-  pokeMessageHeader msgHdrAddr-    (ptrToAddr (PM.mutableByteArrayContents sockAddrBuf)) maxSockAddrSz iovecsAddr-    chunkCount nullAddr 0 flags-  r <- c_unsafe_addr_recvmsg s msgHdrAddr# flags-  if r > (-1)-    then do-      actualSockAddrSz <- PST.peekMessageHeaderNameLength msgHdrAddr-      if actualSockAddrSz < maxSockAddrSz-        then shrinkMutableByteArray sockAddrBuf (cintToInt actualSockAddrSz)-        else pure ()-      sockAddr <- PM.unsafeFreezeByteArray sockAddrBuf-      filled <- countAndShrinkIOVectors (csizeToInt chunkCount) (cssizeToInt r) (csizeToInt chunkSize) bufs-      frozenBufs <- deepFreezeIOVectors filled bufs-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      touchMutableByteArray sockAddrBuf-      pure (Right (actualSockAddrSz,SocketAddress sockAddr,cssizeToCSize r,frozenBufs))-    else do-      touchMutableUnliftedArray bufs-      touchMutableByteArray iovecsBuf-      touchMutableByteArray msgHdrBuf-      touchMutableByteArray sockAddrBuf-      fmap Left getErrno---- This sets up an array of iovec. The iov_len is assigned to the--- same length in all of these. The actual buffers are allocated--- and stuck in an unlifted array. Pointers to these buffers (we can--- do that because they are pinned) go in the iov_base field.-initializeIOVectors ::-     MutableUnliftedArray RealWorld (MutableByteArray RealWorld) -- buffers-  -> Addr -- array of iovec-  -> CSize -- chunk size-  -> CSize -- chunk count-  -> IO ()-initializeIOVectors bufs iovecsAddr chunkSize chunkCount =-  let go !ix !iovecAddr = if ix < csizeToInt chunkCount-        then do-          initializeIOVector bufs iovecAddr chunkSize ix-          go (ix + 1) (plusAddr iovecAddr (cintToInt PST.sizeofIOVector))-        else pure ()-   in go 0 iovecsAddr---- Initialize a single iovec. We write the pinned byte array into--- both the iov_base field and into an unlifted array. There is a--- copy of this function in Linux.Socket.-initializeIOVector ::-     MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> Addr-  -> CSize-  -> Int-  -> IO ()-initializeIOVector bufs iovecAddr chunkSize ix = do-  buf <- PM.newPinnedByteArray (csizeToInt chunkSize)-  PM.writeUnliftedArray bufs ix buf-  let !(Exts.Ptr bufAddr#) = PM.mutableByteArrayContents buf-      bufAddr = Addr bufAddr#-  PST.pokeIOVectorBase iovecAddr bufAddr-  PST.pokeIOVectorLength iovecAddr chunkSize---- This is intended to be called on an array of iovec after recvmsg--- and before deepFreezeIOVectors. An adaptation of this function exists--- in Linux.Socket.-countAndShrinkIOVectors ::-     Int -- Total number of supplied iovecs-  -> Int -- Total amount of space used by receive-  -> Int -- Amount of space per buffer (each buffer must have equal size)-  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> IO Int-countAndShrinkIOVectors !n !totalUsedSz !maxBufSz !bufs = go 0 totalUsedSz where-  -- This outer if (checking that the index is in bounds) should-  -- not actually be necessary. I will remove once the test suite-  -- bolsters my confidence.-  go !ix !remainingBytes = if ix < n-    then if remainingBytes >= maxBufSz-      then go-        (ix + 1)-        (remainingBytes - maxBufSz)-      else if remainingBytes == 0-        then pure ix-        else do-          buf <- PM.readUnliftedArray bufs ix-          shrinkMutableByteArray buf remainingBytes-          pure (ix + 1)-    else pure ix---- Freeze a slice of the mutable byte arrays inside the unlifted--- array. This copies makes a copy of the slice of the original--- array. A copy of this function exists in Linux.Socket.-deepFreezeIOVectors ::-     Int -- How many iovecs actually had a non-zero number of bytes-  -> MutableUnliftedArray RealWorld (MutableByteArray RealWorld)-  -> IO (UnliftedArray ByteArray)-deepFreezeIOVectors n m = do-  x <- PM.unsafeNewUnliftedArray n-  let go !ix = if ix < n-        then do-          PM.writeUnliftedArray x ix =<< PM.unsafeFreezeByteArray =<< PM.readUnliftedArray m ix-          go (ix + 1)-        else PM.unsafeFreezeUnliftedArray x-  go 0--touchMutableUnliftedArray :: MutableUnliftedArray RealWorld a -> IO ()-touchMutableUnliftedArray (MutableUnliftedArray x) = touchMutableUnliftedArray# x--touchUnliftedArray :: UnliftedArray a -> IO ()-touchUnliftedArray (UnliftedArray x) = touchUnliftedArray# x--touchMutableUnliftedArray# :: MutableUnliftedArray# RealWorld a -> IO ()-touchMutableUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)--touchUnliftedArray# :: UnliftedArray# a -> IO ()-touchUnliftedArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)-#endif--unByteArray :: ByteArray -> ByteArray#-unByteArray (ByteArray x) = x--touchMutableByteArray :: MutableByteArray RealWorld -> IO ()-touchMutableByteArray (MutableByteArray x) = touchMutableByteArray# x--touchMutableByteArray# :: MutableByteArray# RealWorld -> IO ()-touchMutableByteArray# x = IO $ \s -> case touch# x s of s' -> (# s', () #)--touchLifted :: a -> IO ()-touchLifted x = IO $ \s -> case touch# x s of s' -> (# s', () #)--{- $conversion-These functions are used to convert IPv4 addresses and ports between network-byte order and host byte order. They are essential when working with-'SocketAddressInternet'. To avoid getting in the way of GHC compile-time-optimizations, these functions are not actually implemented with FFI-calls to @htonl@ and friends. Rather, they are reimplemented in haskell.--}---{- $receiveMessage-The function @recvMsg@ presents us with a challenge. Since it uses a-data structure with many nested pointers, we have to use pinned byte-arrays for everything. There is also the difficulty of marshalling-haskell's unlifted array (array of arrays) type into what C's-array of @iovec@. There's the question of the array of @cmsghdr@s.-On top of all of this, we have to answer the question of whether-we want to accept mutable buffer or whether we want to do the-allocations internally (both for the buffers and for the ancilliary-data structurs needed to massage the data into what C expects).--What we do to handle this in offer several variants of @recvmsg@-ending in @A@, @B@, etc.--}--isByteArrayPinned :: ByteArray -> Bool-{-# inline isByteArrayPinned #-}-isByteArrayPinned (ByteArray arr#) =-  Exts.isTrue# (Exts.isByteArrayPinned# arr#)--isMutableByteArrayPinned :: MutableByteArray s -> Bool-{-# inline isMutableByteArrayPinned #-}-isMutableByteArrayPinned (MutableByteArray marr#) =-  Exts.isTrue# (Exts.isMutableByteArrayPinned# marr#)--unMba :: MutableByteArray s -> MutableByteArray# s-{-# inline unMba #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GADTSyntax #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UnliftedFFITypes #-}++{- | Types and functions related to the POSIX sockets API.+  Unusual characteristics:++  * Any time the standard calls for @socklen_t@, we use+    @CInt@ instead. Linus Torvalds <https://yarchive.net/comp/linux/socklen_t.html writes>+    that \"Any sane library must have @socklen_t@ be the same size as @int@.+    Anything else breaks any BSD socket layer stuff.\"+  * Send and receive each have several variants. They are distinguished by+    the safe\/unsafe FFI use and by the @Addr@\/@ByteArray@/@MutableByteArray@+    buffer type. They all call @send@ or @recv@ exactly once. They do not+    repeatedly make syscalls like some of the functions in @network@.+    Users who want that behavior need to build on top of this package.+  * 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+    uninterruptibleSocket+  , socket+  , withSocket++    -- ** Socket Pair+  , uninterruptibleSocketPair++    -- ** Address Resolution+  , getAddressInfo+  , uninterruptibleFreeAddressInfo++    -- ** Bind+  , uninterruptibleBind++    -- ** Connect+  , connect+  , uninterruptibleConnect+  , uninterruptibleConnectPtr++    -- ** Listen+  , uninterruptibleListen++    -- ** Accept+  , accept+  , uninterruptibleAccept+  , accept_++    -- ** Get Socket Name+  , uninterruptibleGetSocketName++    -- ** Get Socket Option+  , uninterruptibleGetSocketOption++    -- ** Set Socket Option+  , uninterruptibleSetSocketOption+  , uninterruptibleSetSocketOptionByteArray+  , uninterruptibleSetSocketOptionInt++    -- ** Close+  , F.close+  , F.uninterruptibleClose+  , F.uninterruptibleErrorlessClose++    -- ** Shutdown+  , uninterruptibleShutdown++    -- ** Send+  , send+  , sendByteArray+  , sendMutableByteArray+  , uninterruptibleSend+  , uninterruptibleSendByteArray+  , uninterruptibleSendMutableByteArray++    -- ** Send To+  , uninterruptibleSendToByteArray+  , uninterruptibleSendToMutableByteArray+  , uninterruptibleSendToInternet+  , uninterruptibleSendToInternetByteArray+  , uninterruptibleSendToInternetMutableByteArray++    -- ** Write Vector++    -- ** Receive+  , receive+  , receiveByteArray+  , uninterruptibleReceive+  , uninterruptibleReceiveMutableByteArray++    -- ** Receive From+  , uninterruptibleReceiveFromMutableByteArray+  , uninterruptibleReceiveFromMutableByteArray_+  , uninterruptibleReceiveFrom_+  , uninterruptibleReceiveFromInternet+  , uninterruptibleReceiveFromInternetMutableByteArray++    -- ** Receive Message+    -- $receiveMessage+  , uninterruptibleSendMessageA+  , uninterruptibleSendMessageB++    -- ** Byte-Order Conversion+    -- $conversion+  , hostToNetworkLong+  , hostToNetworkShort+  , networkToHostLong+  , networkToHostShort++    -- * Types+  , Family (..)+  , Type (..)+  , Protocol (..)+  , OptionName (..)+  , OptionValue (..)+  , Level (..)+  , Message (..)+  , MessageFlags (..)+  , ShutdownType (..)+  , AddressInfo++    -- * Socket Address++    -- ** Types+  , SocketAddress (..)+  , PST.SocketAddressInternet (..)+  , PST.SocketAddressUnix (..)++    -- ** Encoding+  , PSP.encodeSocketAddressInternet+  , PSP.encodeSocketAddressUnix++    -- ** Decoding+  , PSP.decodeSocketAddressInternet+  , PSP.indexSocketAddressInternet++    -- ** Sizes+  , PSP.sizeofSocketAddressInternet++    -- * Data Construction++    -- ** Socket Domains+  , pattern PST.Unix+  , pattern PST.Unspecified+  , pattern PST.Internet+  , pattern PST.Internet6++    -- ** Socket Types+  , PST.stream+  , PST.datagram+  , PST.raw+  , PST.sequencedPacket++    -- ** Protocols+  , PST.defaultProtocol+  , PST.rawProtocol+  , PST.icmp+  , PST.tcp+  , PST.udp+  , PST.ip+  , PST.ipv6++    -- ** Receive Flags+  , PST.peek+  , PST.outOfBand+  , PST.waitAll++    -- ** Send Flags+  , PST.noSignal++    -- ** Shutdown Types+  , PST.read+  , PST.write+  , PST.readWrite++    -- ** Socket Levels+  , 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+  , PST.pokeMessageHeaderIOVector+  , PST.pokeMessageHeaderIOVectorLength+  , PST.pokeMessageHeaderControl+  , PST.pokeMessageHeaderControlLength+  , PST.pokeMessageHeaderFlags++    -- *** Metadata+  , PST.sizeofMessageHeader++    -- ** IO Vector++    -- *** Peek+  , PST.peekIOVectorBase+  , PST.peekIOVectorLength++    -- *** Poke+  , PST.pokeIOVectorBase+  , PST.pokeIOVectorLength++    -- *** Metadata+  , PST.sizeofIOVector+  ) where++import Control.Exception (mask, onException)+import Data.Primitive (ByteArray (..), MutableByteArray (..), MutablePrimArray (..))+import Data.Primitive.Addr (Addr (..))+import Data.Primitive.ByteArray.Offset (MutableByteArrayOffset (..))+import Data.Primitive.PrimArray.Offset (MutablePrimArrayOffset (..))+import Data.Void (Void)+import Data.Word (Word16, Word32, Word8, byteSwap16, byteSwap32)+import Foreign.C.Error (Errno (Errno), getErrno)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt (..), CSize (..))+import Foreign.Ptr (nullPtr)+import GHC.ByteOrder (ByteOrder (BigEndian, LittleEndian), targetByteOrder)+import GHC.Exts (Addr#, ByteArray#, Int (I#), MutableByteArray#, Ptr (Ptr), RealWorld, shrinkMutableByteArray#)+import Posix.Socket.Types+  ( AddressInfo+  , Family (..)+  , Level (..)+  , Message (..)+  , MessageFlags (..)+  , OptionName (..)+  , OptionValue (..)+  , Protocol (..)+  , ShutdownType (..)+  , SocketAddress (..)+  , SocketAddressInternet (..)+  , Type (..)+  )+import System.Posix.Types (CSsize (..), Fd (..))++import qualified Control.Monad.Primitive as PM+import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts+import qualified Posix.File as F+import qualified Posix.Socket.Types as PST++-- This module include operating-system specific code used+-- to serialize some of various kind of socket address types.+import qualified Posix.Socket.Platform as PSP++-- 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 :: Family -> Type -> Protocol -> IO Fd++foreign import ccall unsafe "sys/socket.h socketpair"+  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 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+-- CInt rather than introducing a type corresponding to socklen_t.+-- According to Linus Torvalds, "Any sane library must have socklen_t+-- be the same size as int. Anything else breaks any BSD socket layer stuff."+-- (https://yarchive.net/comp/linux/socklen_t.html). If a platform+-- violates this assumption, this wrapper will be broken on that platform.+foreign import ccall unsafe "sys/socket.h bind"+  c_bind :: Fd -> ByteArray# -> CInt -> IO CInt++-- Per the spec, the type signature of accept is:+--   int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);+-- The restrict keyword does not matter much for our purposes. See the+-- note on c_bind for why we use CInt for socklen_t. Remember that the+-- first bytearray argument is actually SocketAddress in the function that+-- wraps this one. The second bytearray argument is a pointer to the size.+foreign import ccall safe "sys/socket.h accept"+  c_safe_accept ::+    Fd ->+    MutableByteArray# RealWorld -> -- SocketAddress+    MutableByteArray# RealWorld -> -- Ptr CInt+    IO Fd+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++foreign import ccall unsafe "sys/socket.h setsockopt_int"+  c_unsafe_setsockopt_int ::+    Fd ->+    Level ->+    OptionName ->+    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.+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+foreign import ccall unsafe "sys/socket.h connect"+  c_unsafe_connect_addr :: Fd -> Addr# -> CInt -> IO CInt++-- There are several options for wrapping send. Both safe and unsafe+-- are useful. Additionally, in the unsafe category, we also+-- have the option of writing to either an address or a byte array.+-- Unsafe FFI calls guarantee that byte arrays will not be relocated+-- while the FFI call is taking place. Safe FFI calls do not have+-- this guarantee, so internally we must be careful when using these to only+-- provide pinned byte arrays as arguments.+foreign import ccall 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# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize+foreign import ccall safe "sys/socket.h send_offset"+  c_safe_mutablebytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> 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 -> MessageFlags 'Send -> IO CSsize+foreign import ccall unsafe "sys/socket.h send_offset"+  c_unsafe_bytearray_send :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> IO CSsize+foreign import ccall unsafe "sys/socket.h send_offset"+  c_unsafe_mutable_bytearray_send :: Fd -> MutableByteArray# RealWorld -> Int -> 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# -> Int -> 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 -> Int -> CSize -> MessageFlags 'Send -> ByteArray# -> CInt -> IO CSsize+foreign import ccall unsafe "sys/socket.h sendto_inet_offset"+  c_unsafe_mutable_bytearray_sendto_inet :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize+foreign import ccall unsafe "HaskellPosix.h sendto_inet_offset"+  c_unsafe_bytearray_sendto_inet :: Fd -> ByteArray# -> Int -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize+foreign import ccall unsafe "HaskellPosix.h sendto_inet_addr"+  c_unsafe_addr_sendto_inet :: Fd -> Addr# -> CSize -> MessageFlags 'Send -> Word16 -> Word32 -> IO CSsize++foreign import ccall unsafe "HaskellPosix.h sendmsg_a"+  c_unsafe_sendmsg_a :: Fd -> Addr# -> CSize -> MutableByteArray# RealWorld -> Int -> CSize -> MessageFlags 'Send -> IO CSsize++foreign import ccall unsafe "HaskellPosix.h sendmsg_b"+  c_unsafe_sendmsg_b :: Fd -> MutableByteArray# RealWorld -> Int -> CSize -> Addr# -> CSize -> MessageFlags 'Send -> IO CSsize++-- There are several ways to wrap recv.+foreign import ccall safe "sys/socket.h recv"+  c_safe_addr_recv :: Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize+foreign import ccall unsafe "sys/socket.h recv"+  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 -> Int -> 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 -> Int -> CSize -> MessageFlags 'Receive -> MutableByteArray# RealWorld -> MutableByteArray# RealWorld -> IO CSsize+foreign import ccall unsafe "sys/socket.h recvfrom_offset_peerless"+  c_unsafe_mutable_byte_array_peerless_recvfrom ::+    Fd ->+    MutableByteArray# RealWorld ->+    Int ->+    CSize ->+    MessageFlags 'Receive ->+    IO CSsize+foreign import ccall unsafe "sys/socket.h recvfrom_addr_peerless"+  c_unsafe_addr_peerless_recvfrom ::+    Fd -> Addr# -> CSize -> MessageFlags 'Receive -> IO CSsize+foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet"+  c_unsafe_recvfrom_inet ::+    Fd ->+    MutableByteArray# RealWorld ->+    Int ->+    CSize ->+    MessageFlags 'Receive ->+    MutableByteArray# RealWorld ->+    Int ->+    IO CSsize+foreign import ccall unsafe "sys/socket.h recvfrom_offset_inet_addr"+  c_unsafe_recvfrom_inet_addr ::+    Fd ->+    Addr# ->+    CSize ->+    MessageFlags 'Receive ->+    MutableByteArray# RealWorld ->+    Int ->+    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. No special preparation is required before calling+  this function. The author believes that it cannot block for a prolonged+  period of time.+-}+uninterruptibleSocket ::+  -- | Communications domain (e.g. 'internet', 'unix')+  Family ->+  -- | Socket type (e.g. 'datagram', 'stream') with flags+  Type ->+  -- | Protocol+  Protocol ->+  IO (Either Errno Fd)+uninterruptibleSocket dom typ prot = c_socket dom typ prot >>= errorsFromFd++-- | Alias for 'uninterruptibleSocket'.+socket ::+  -- | Communications domain (e.g. 'internet', 'unix')+  Family ->+  -- | Socket type (e.g. 'datagram', 'stream') with flags+  Type ->+  -- | Protocol+  Protocol ->+  IO (Either Errno Fd)+socket = uninterruptibleSocket++{- | Helper function for the common case where 'socket' or+'uninterruptibleSocket' is paired with 'close'. This ensures that the+socket is closed even in the case of an exception. Do not call 'close' in+the callback since 'close' is called by this function after the callback+completes (or after an exception is thrown).++This is implementated with @mask@ (and restore) and @onException@+directly rather than with @bracket@.+-}+withSocket ::+  -- | Communications domain (e.g. 'internet', 'unix')+  Family ->+  -- | Socket type (e.g. 'datagram', 'stream') with flags+  Type ->+  -- | Protocol+  Protocol ->+  -- | Callback that uses the socket. Must not close the socket.+  -- The callback is not used when the @socket()@ call fails.+  (Fd -> IO a) ->+  IO (Either Errno a)+{-# INLINE withSocket #-}+withSocket !dom !typ !prot cb =+  mask $ \restore -> do+    r <- c_socket dom typ prot+    if r > (-1)+      then do+        a <- restore (cb r) `onException` F.close r+        _ <- F.close r+        pure (Right a)+      else fmap Left getErrno++{- | 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. No special preparation is required before calling+  this function. The author believes that it cannot block for a prolonged+  period of time.+-}+uninterruptibleSocketPair ::+  -- | Communications domain (probably 'unix')+  Family ->+  -- | Socket type (e.g. 'datagram', 'stream') with flags+  Type ->+  -- | Protocol+  Protocol ->+  IO (Either Errno (Fd, Fd))+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+  r <- c_socketpair dom typ prot sockets#+  if r == 0+    then do+      fd1 <- PM.readPrimArray sockets 0+      fd2 <- PM.readPrimArray sockets 1+      pure (Right (fd1, fd2))+    else fmap Left getErrno++{- | 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 ::+  -- | Node, identifies an Internet host+  CString ->+  -- | Service+  CString ->+  -- | Hints+  Ptr AddressInfo ->+  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>+  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. No special+  preparation is required before calling this function. The author+  believes that it cannot block for a prolonged period of time.+-}+uninterruptibleBind ::+  -- | Socket+  Fd ->+  -- | Socket address, extensible tagged union+  SocketAddress ->+  IO (Either Errno ())+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. No special preparation is required before+  calling this function. The author believes that it cannot block+  for a prolonged period of time.+-}+uninterruptibleListen ::+  -- | Socket+  Fd ->+  -- | Backlog+  CInt ->+  IO (Either Errno ())+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.+-}+connect ::+  -- | Fd+  Fd ->+  -- | Socket address, extensible tagged union+  SocketAddress ->+  IO (Either Errno ())+connect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =+  case 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 ->+  -- | Socket address, extensible tagged union+  SocketAddress ->+  IO (Either Errno ())+uninterruptibleConnect fd (SocketAddress sockAddr@(ByteArray sockAddr#)) =+  c_unsafe_connect fd sockAddr# (intToCInt (PM.sizeofByteArray sockAddr)) >>= errorsFromInt_++uninterruptibleConnectPtr ::+  -- | Fd+  Fd ->+  -- | Socket address+  Ptr a ->+  -- | Size of socket address+  Int ->+  IO (Either Errno ())+uninterruptibleConnectPtr !fd (Ptr sockAddr#) !sz =+  c_unsafe_connect_addr fd sockAddr# (intToCInt sz) >>= errorsFromInt_++{- | Extract the first connection on the queue of pending connections. The+  <http://pubs.opengroup.org/onlinepubs/9699919799/functions/accept.html POSIX specification>+  includes more details. This function\'s type differs slightly from+  the specification:++  > int accept(int socket, struct sockaddr *restrict address, socklen_t *restrict address_len);++  Instead of requiring the caller to prepare buffers through which+  information is returned, this haskell binding to @accept@ prepares+  those buffers internally. This eschews C\'s characteristic buffer-passing+  in favor of the Haskell convention of allocating internally and returning.++  More specifically, this binding lacks an argument corresponding to the+  @sockaddr@ buffer from the specification. That mutable buffer is allocated+  internally, resized and frozen upon a success, and returned along with+  the file descriptor of the accepted socket. The size of this buffer is+  determined by the second argument (maximum socket address size). This+  size argument is also writen to the @address_len@ buffer, which is also+  allocated internally. The size returned through this pointer is used to+  resize the @sockaddr@ buffer, which is then frozen so that an immutable+  'SocketAddress' is returned to the end user.++  For applications uninterested in the peer (described by @sockaddr@),+  POSIX @accept@ allows the null pointer to be passed as both @address@ and+  @address_len@. This behavior is provided by 'accept_'.+-}+accept ::+  -- | Listening socket+  Fd ->+  -- | Maximum socket address size+  CInt ->+  -- | Peer information and connected socket+  IO (Either Errno (CInt, SocketAddress, Fd))+accept !sock !maxSz = do+  sockAddrBuf@(MutableByteArray sockAddrBuf#) <- PM.newPinnedByteArray (cintToInt maxSz)+  lenBuf@(MutableByteArray lenBuf#) <- PM.newPinnedByteArray (PM.sizeOf (undefined :: CInt))+  PM.writeByteArray lenBuf 0 maxSz+  r <- c_safe_accept sock sockAddrBuf# lenBuf#+  if r > (-1)+    then do+      (sz :: CInt) <- PM.readByteArray lenBuf 0+      -- 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+      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 ::+  -- | Listening socket+  Fd ->+  -- | Maximum socket address size+  CInt ->+  -- | Peer information and connected socket+  IO (Either Errno (CInt, SocketAddress, Fd))+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_ ::+  -- | Listening socket+  Fd ->+  -- | Connected socket+  IO (Either Errno Fd)+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 ::+  -- | Socket+  Fd ->+  -- | Maximum socket address size+  CInt ->+  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 ::+  -- | Socket+  Fd ->+  -- | Socket level+  Level ->+  OptionName -> -- Option name++  -- | Maximum option value size+  CInt ->+  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++{- | Set the value for the option specified by the 'Option' argument for+  the socket specified by the 'Fd' argument. The+  <http://pubs.opengroup.org/onlinepubs/9699919799/functions/getsockopt.html POSIX specification>+  of @getsockopt@ includes more details. This variant requires that the+  size of the @option_value@+  be the same as the size of 'CInt'. That is, the @option_name@ must+  describe an option that is represented by a C integer. This is a+  common case, so we avoid allocations by reference-passing in C.+-}+uninterruptibleSetSocketOptionInt ::+  -- | Socket+  Fd ->+  -- | Socket level+  Level ->+  -- | Option name+  OptionName ->+  -- | Option value+  CInt ->+  IO (Either Errno ())+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 ::+  -- | Socket+  Fd ->+  -- | Socket level+  Level ->+  -- | Option name+  OptionName ->+  -- | Option value+  Ptr Void ->+  -- | Option value length+  CInt ->+  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 ::+  -- | Socket+  Fd ->+  -- | Socket level+  Level ->+  -- | Option name+  OptionName ->+  -- | Option value+  ByteArray ->+  -- | Option value length+  CInt ->+  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+  FFI, it allocates a pinned copy of the bytearry if it was not+  already pinned.+-}+sendByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+sendByteArray fd b@(ByteArray b#) off len flags =+  if isByteArrayPinned b+    then errorsFromSize =<< c_safe_bytearray_send fd b# off len flags+    else do+      x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)+      PM.copyByteArray x off b 0 (csizeToInt len)+      errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags++{- | Copy and pin a byte array if, it's not already pinned.+pinByteArray :: ByteArray -> IO (Maybe ByteArray)+{\-# INLINE pinByteArray #-\}+pinByteArray byteArray =+  if isByteArrayPinned byteArray+    then+      pure Nothing+    else do+      pinnedByteArray <- PM.newPinnedByteArray len+      PM.copyByteArray pinnedByteArray 0 byteArray 0 len+      r <- PM.unsafeFreezeByteArray pinnedByteArray+      pure (Just r)+  where+    len = PM.sizeofByteArray byteArray+-}++{- | Send two payloads (one from unmanaged memory and one from+managed memory) over a network socket.+-}+uninterruptibleSendMessageA ::+  -- | Socket+  Fd ->+  -- | Source address (payload A)+  Addr ->+  -- | Length in bytes (payload A)+  CSize ->+  -- | Source and offset (payload B)+  MutableByteArrayOffset RealWorld ->+  -- | Length in bytes (payload B)+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+uninterruptibleSendMessageA+  fd+  (Addr addr)+  lenA+  (MutableByteArrayOffset {array, offset})+  lenB+  flags =+    c_unsafe_sendmsg_a fd addr lenA (unMba array) offset lenB flags+      >>= errorsFromSize++{- | Send two payloads (one from managed memory and one from+unmanaged memory) over a network socket.+-}+uninterruptibleSendMessageB ::+  -- | Socket+  Fd ->+  -- | Source and offset (payload B)+  MutableByteArrayOffset RealWorld ->+  -- | Length in bytes (payload B)+  CSize ->+  -- | Source address (payload A)+  Addr ->+  -- | Length in bytes (payload A)+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+uninterruptibleSendMessageB+  fd+  (MutableByteArrayOffset {array, offset})+  lenB+  (Addr addr)+  lenA+  flags =+    c_unsafe_sendmsg_b fd (unMba array) offset lenB addr lenA flags+      >>= errorsFromSize++{- | 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+  FFI, it allocates a pinned copy of the bytearry if it was not+  already pinned.+-}+sendMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  MutableByteArray RealWorld ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+sendMutableByteArray fd b@(MutableByteArray b#) off len flags =+  if isMutableByteArrayPinned b+    then errorsFromSize =<< c_safe_mutablebytearray_send fd b# off len flags+    else do+      x@(MutableByteArray x#) <- PM.newPinnedByteArray (csizeToInt len)+      PM.copyMutableByteArray x off b 0 (csizeToInt len)+      errorsFromSize =<< c_safe_mutablebytearray_no_offset_send fd x# len flags++{- | Send data from an address over a network socket. This is not guaranteed+  to send the entire length. This uses the safe FFI since+  it may block indefinitely.+-}+send ::+  -- | Connected socket+  Fd ->+  -- | Source address+  Addr ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+send fd (Addr addr) len flags =+  c_safe_addr_send fd addr len flags >>= errorsFromSize++{- | Send data from an address over a network socket. This uses the unsafe FFI.+  Users of this function should be sure to set flags that prohibit this+  from blocking. On Linux this is accomplished with @O_NONBLOCK@. It is+  often desirable to call 'threadWaitWrite' on a nonblocking socket before+  calling @unsafeSend@ on it.+-}+uninterruptibleSend ::+  -- | Socket+  Fd ->+  -- | Source address+  Addr ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+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.+-}+uninterruptibleSendByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+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.+-}+uninterruptibleSendMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Source mutable byte array+  MutableByteArray RealWorld ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+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.+  This uses the unsafe FFI; considerations pertaining to 'sendToUnsafe'+  apply to this function as well. The offset and length arguments+  cause a slice of the byte array to be sent rather than the entire+  byte array.+-}+uninterruptibleSendToByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Socket Address+  SocketAddress ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+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++{- | Variant of 'uninterruptibleSendToByteArray' that requires+  that @sockaddr_in@ be used as the socket address. This is used to+  avoid allocating a buffer for the socket address when the caller+  knows in advance that they are sending to an IPv4 address.+-}+uninterruptibleSendToInternetByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  ByteArray ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Socket Address+  SocketAddressInternet ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+uninterruptibleSendToInternetByteArray fd (ByteArray b) off len flags (SocketAddressInternet {port, address}) =+  c_unsafe_bytearray_sendto_inet fd b off len flags port address >>= errorsFromSize++{- | Variant of 'uninterruptibleSendToByteArray' that requires+  that @sockaddr_in@ be used as the socket address. This is used to+  avoid allocating a buffer for the socket address when the caller+  knows in advance that they are sending to an IPv4 address.+-}+uninterruptibleSendToInternet ::+  -- | Socket+  Fd ->+  -- | Source byte array+  Addr ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Socket Address+  SocketAddressInternet ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+uninterruptibleSendToInternet fd (Addr b) len flags (SocketAddressInternet {port, address}) =+  c_unsafe_addr_sendto_inet fd b len flags port address >>= errorsFromSize++{- | Send data from a mutable byte array over an unconnected network socket.+  This uses the unsafe FFI; concerns pertaining to 'uninterruptibleSend'+  apply to this function as well. The offset and length arguments+  cause a slice of the mutable byte array to be sent rather than the entire+  byte array.+-}+uninterruptibleSendToMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  MutableByteArray RealWorld ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Socket Address+  SocketAddress ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+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++{- | Variant of 'uninterruptibleSendToMutableByteArray' that requires+  that @sockaddr_in@ be used as the socket address. This is used to+  avoid allocating a buffer for the socket address when the caller+  knows in advance that they are sending to an IPv4 address.+-}+uninterruptibleSendToInternetMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Source byte array+  MutableByteArray RealWorld ->+  -- | Offset into source array+  Int ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Send ->+  -- | Socket Address+  SocketAddressInternet ->+  -- | Number of bytes pushed to send buffer+  IO (Either Errno CSize)+uninterruptibleSendToInternetMutableByteArray fd (MutableByteArray b) off len flags (SocketAddressInternet {port, address}) =+  c_unsafe_mutable_bytearray_sendto_inet fd b off len flags port address >>= errorsFromSize++{- | Receive data into an address from a network socket. This wraps @recv@ using+  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 ::+  -- | Socket+  Fd ->+  -- | Source address+  Addr ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  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 FFI. When the returned size is zero, there are no+  additional bytes to receive and the peer has performed an orderly shutdown.+-}+receiveByteArray ::+  -- | Socket+  Fd ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  IO (Either Errno ByteArray)+receiveByteArray !fd !len !flags = do+  m <- PM.newPinnedByteArray (csizeToInt len)+  let !(Addr addr) = ptrToAddr (PM.mutableByteArrayContents m)+  r <- c_safe_addr_recv fd addr len flags+  if r /= (-1)+    then do+      -- Why copy when we could just shrink? We want to always return+      -- byte arrays that are not explicitly pinned.+      let sz = cssizeToInt r+      x <- PM.newByteArray sz+      PM.copyMutableByteArray x 0 m 0 sz+      a <- PM.unsafeFreezeByteArray x+      pure (Right a)+    else fmap Left getErrno++{- | Receive data into an address from a network socket. This wraps @recv@+  using the unsafe FFI. Users of this function should be sure to set flags+  that prohibit this from blocking. On Linux this is accomplished by setting+  the @MSG_DONTWAIT@ flag and handling the resulting @EAGAIN@ or+  @EWOULDBLOCK@. When the returned size is zero, there are no additional+  bytes to receive and the peer has performed an orderly shutdown.+-}+uninterruptibleReceive ::+  -- | Socket+  Fd ->+  -- | Source address+  Addr ->+  -- | Length in bytes+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceive #-}+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.+-}+uninterruptibleReceiveMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  MutableByteArray RealWorld ->+  -- | Destination offset+  Int ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Bytes received into array+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceiveMutableByteArray #-}+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. This function does not resize the buffer.+-}+uninterruptibleReceiveFromMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  MutableByteArray RealWorld ->+  -- | Destination offset+  Int ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Maximum socket address size+  CInt ->+  -- | Remote host, bytes received into array, bytes needed for @addrlen@.+  IO (Either Errno (CInt, SocketAddress, CSize))+{-# 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+  -- TODO: We currently allocate one buffer for the size and+  -- one for the peer. We could improve this by allocating+  -- a single buffer instead. We would need to add some+  -- cleverness in the cbits directory.+  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+      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++uninterruptibleReceiveFromInternet ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  Addr ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Address+  MutablePrimArrayOffset RealWorld SocketAddressInternet ->+  -- | Number of bytes received into array+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceiveFromInternet #-}+uninterruptibleReceiveFromInternet+  !fd+  (Addr b)+  !len+  !flags+  (MutablePrimArrayOffset (MutablePrimArray sockAddrBuf) addrOff) =+    c_unsafe_recvfrom_inet_addr fd b len flags sockAddrBuf addrOff+      >>= errorsFromSize++uninterruptibleReceiveFromInternetMutableByteArray ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  MutableByteArrayOffset RealWorld ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Address+  MutablePrimArrayOffset RealWorld SocketAddressInternet ->+  -- | Number of bytes received into array+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceiveFromInternetMutableByteArray #-}+uninterruptibleReceiveFromInternetMutableByteArray+  !fd+  (MutableByteArrayOffset (MutableByteArray b) off)+  !len+  !flags+  (MutablePrimArrayOffset (MutablePrimArray sockAddrBuf) addrOff) =+    c_unsafe_recvfrom_inet fd b off len flags sockAddrBuf addrOff+      >>= errorsFromSize++{- | 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.+-}+uninterruptibleReceiveFromMutableByteArray_ ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  MutableByteArray RealWorld ->+  -- | Destination offset+  Int ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Number of bytes received into array+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceiveFromMutableByteArray_ #-}+uninterruptibleReceiveFromMutableByteArray_ !fd (MutableByteArray !b) !off !len !flags =+  c_unsafe_mutable_byte_array_peerless_recvfrom fd b off len flags+    >>= errorsFromSize++{- | 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.+-}+uninterruptibleReceiveFrom_ ::+  -- | Socket+  Fd ->+  -- | Destination byte array+  Addr ->+  -- | Maximum bytes to receive+  CSize ->+  -- | Flags+  MessageFlags 'Receive ->+  -- | Number of bytes received into array+  IO (Either Errno CSize)+{-# INLINE uninterruptibleReceiveFrom_ #-}+uninterruptibleReceiveFrom_ !fd (Addr !b) !len !flags =+  c_unsafe_addr_peerless_recvfrom fd b len flags+    >>= errorsFromSize++ptrToAddr :: Ptr Word8 -> Addr+ptrToAddr (Exts.Ptr a) = Addr a++-- | 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))+    else fmap Left getErrno++errorsFromFd :: Fd -> IO (Either Errno Fd)+errorsFromFd r =+  if r > (-1)+    then pure (Right r)+    else fmap Left getErrno++-- Sometimes, functions that return an int use zero to indicate+-- success and negative one to indicate failure without including+-- additional information in the value.+errorsFromInt_ :: CInt -> IO (Either Errno ())+errorsFromInt_ r =+  if r == 0+    then pure (Right ())+    else fmap Left getErrno++intToCInt :: Int -> CInt+intToCInt = fromIntegral++cintToInt :: CInt -> Int+cintToInt = fromIntegral++csizeToInt :: CSize -> Int+csizeToInt = fromIntegral++cssizeToInt :: CSsize -> Int+cssizeToInt = fromIntegral++-- only call this when it is known that the argument is non-negative+cssizeToCSize :: CSsize -> CSize+cssizeToCSize = fromIntegral++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.+-}++{- $receiveMessage+The function @recvMsg@ presents us with a challenge. Since it uses a+data structure with many nested pointers, we have to use pinned byte+arrays for everything. There is also the difficulty of marshalling+haskell's unlifted array (array of arrays) type into what C's+array of @iovec@. There's the question of the array of @cmsghdr@s.+On top of all of this, we have to answer the question of whether+we want to accept mutable buffer or whether we want to do the+allocations internally (both for the buffers and for the ancilliary+data structurs needed to massage the data into what C expects).++What we do to handle this in offer several variants of @recvmsg@+ending in @A@, @B@, etc.+-}++isByteArrayPinned :: ByteArray -> Bool+{-# INLINE isByteArrayPinned #-}+isByteArrayPinned (ByteArray arr#) =+  Exts.isTrue# (Exts.isByteArrayPinned# arr#)++isMutableByteArrayPinned :: MutableByteArray s -> Bool+{-# INLINE isMutableByteArrayPinned #-}+isMutableByteArrayPinned (MutableByteArray marr#) =+  Exts.isTrue# (Exts.isMutableByteArrayPinned# marr#)++unMba :: MutableByteArray s -> MutableByteArray# s+{-# INLINE unMba #-} unMba (MutableByteArray x) = x

@@ -7,18 +7,6 @@   ( CNfds(..)   ) where -import Data.Word--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

@@ -1,61 +1,56 @@-{-# language BangPatterns #-}-{-# language BinaryLiterals #-}-{-# language LambdaCase #-}-{-# language NamedFieldPuns #-}-{-# language ScopedTypeVariables #-}-{-# language TypeApplications #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BinaryLiterals #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} -import Control.Concurrent (forkIO)-import Control.Concurrent (threadWaitRead,threadWaitWrite)+import Control.Concurrent (forkIO, threadWaitWrite) import Control.Monad (when)-import Data.Primitive (ByteArray,MutablePrimArray(..),MutableByteArray(..))-import Data.Word (Word32,Word8)-import Foreign.C.Error (Errno,errnoToIOError)-import Foreign.C.Types (CInt,CSize)+import Data.Primitive (ByteArray, MutableByteArray (..), MutablePrimArray (..))+import Data.Word (Word8)+import Foreign.C.Error (Errno, errnoToIOError)+import Foreign.C.Types (CSize) import GHC.Exts (RealWorld) import Numeric (showIntAtBase) import Test.Tasty import Test.Tasty.HUnit -import qualified GHC.Exts as E import qualified Data.Primitive as PM-import qualified Data.Primitive.Unlifted.Array as PM import qualified Data.Primitive.MVar as PM-import qualified Posix.Socket as S-import qualified Linux.Socket as L+import qualified GHC.Exts as E import qualified Linux.Epoll as Epoll+import qualified Posix.Socket as S  main :: IO () main = defaultMain tests  tests :: TestTree-tests = testGroup "tests"-  [ testGroup "posix"-    [ testGroup "sockets"-      [ testCase "A" testSocketsA-      , testCase "B" testSocketsB-      , testCase "C" testSocketsC-      , testCase "D" testSocketsD-      , testCase "E" testSocketsE-      , testCase "F" testSocketsF-      , testCase "G" testSocketsG-      ]-    ]-  , testGroup "linux"-    [ testGroup "sockets"-      [ testCase "A" testLinuxSocketsA-      , testCase "B" testLinuxSocketsB-      , testCase "C" testLinuxSocketsC-      ]-    , testGroup "epoll"-      [ testCase "A" testLinuxEpollA-      ]+tests =+  testGroup+    "tests"+    [ testGroup+        "posix"+        [ testGroup+            "sockets"+            [ testCase "A" testSocketsA+            , testCase "B" testSocketsB+            , testCase "C" testSocketsC+            , testCase "D" testSocketsD+            ]+        ]+    , testGroup+        "linux"+        [ testGroup+            "epoll"+            [ testCase "A" testLinuxEpollA+            ]+        ]     ]-  ]  testSocketsA :: Assertion testSocketsA = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol+  (a, b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol   m <- PM.newEmptyMVar   _ <- forkIO $ S.receiveByteArray b 5 mempty >>= PM.putMVar m   bytesSent <- demand =<< S.sendByteArray a sample 0 5 mempty@@ -68,26 +63,28 @@   let limit = 10       wordSz = PM.sizeOf (undefined :: Int)       cwordSz = fromIntegral wordSz :: CSize-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol+  (a, b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol   lock <- PM.newEmptyMVar-  let go1 !(ix :: Int) !(n :: Int) = if (ix < limit)-        then do-          y <- PM.newByteArray wordSz-          PM.writeByteArray y 0 (1 + n)-          z <- PM.unsafeFreezeByteArray y-          oneWord =<< demand =<< S.sendByteArray b z 0 cwordSz mempty-          x <- demand =<< S.receiveByteArray b cwordSz mempty-          go1 (ix + 1) (PM.indexByteArray x 0)-        else pure n-      go2 !(ix :: Int) = if (ix < limit)-        then do-          x <- demand =<< S.receiveByteArray a cwordSz mempty-          y <- PM.newByteArray wordSz-          PM.writeByteArray y 0 (1 + PM.indexByteArray x 0 :: Int) -          z <- PM.unsafeFreezeByteArray y-          oneWord =<< demand =<< S.sendByteArray a z 0 cwordSz mempty-          go2 (ix + 1)-        else PM.putMVar lock ()+  let go1 !(ix :: Int) !(n :: Int) =+        if (ix < limit)+          then do+            y <- PM.newByteArray wordSz+            PM.writeByteArray y 0 (1 + n)+            z <- PM.unsafeFreezeByteArray y+            oneWord =<< demand =<< S.sendByteArray b z 0 cwordSz mempty+            x <- demand =<< S.receiveByteArray b cwordSz mempty+            go1 (ix + 1) (PM.indexByteArray x 0)+          else pure n+      go2 !(ix :: Int) =+        if (ix < limit)+          then do+            x <- demand =<< S.receiveByteArray a cwordSz mempty+            y <- PM.newByteArray wordSz+            PM.writeByteArray y 0 (1 + PM.indexByteArray x 0 :: Int)+            z <- PM.unsafeFreezeByteArray y+            oneWord =<< demand =<< S.sendByteArray a z 0 cwordSz mempty+            go2 (ix + 1)+          else PM.putMVar lock ()   _ <- forkIO (go2 0)   r <- go1 0 0   PM.takeMVar lock@@ -95,7 +92,7 @@  testSocketsC :: Assertion testSocketsC = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol+  (a, b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol   m <- PM.newEmptyMVar   _ <- forkIO $ S.receiveByteArray a 5 mempty >>= PM.putMVar m   bytesSent <- demand =<< S.sendByteArray b sample 0 5 mempty@@ -105,175 +102,33 @@  testSocketsD :: Assertion testSocketsD = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol+  (a, b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol   _ <- forkIO $ do     bytesSent <- demand =<< S.sendByteArray b sample 0 5 mempty     when (bytesSent /= 5) (fail "testSocketsD: bytesSent was wrong")   actual <- demand =<< S.receiveByteArray a 5 mempty   sample @=? actual -testSocketsE :: Assertion-testSocketsE = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol-  _ <- forkIO $ do-    threadWaitWrite b-    bytesSent <- demand =<< S.uninterruptibleSendByteArray b sample 0 5 mempty-    when (bytesSent /= 5) (fail "testSocketsE: bytesSent was wrong")-  threadWaitRead a-  actual <- demand =<< S.uninterruptibleReceiveMessageA a 3 10 mempty-  (5,E.fromList [E.fromList [1,2,3],E.fromList [4,5]]) @=? actual--testSocketsF :: Assertion-testSocketsF = do-  a <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind a (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))-  (expectedSzA,expectedSockAddrA) <- demand =<< S.uninterruptibleGetSocketName a 128-  when (expectedSzA > 128) (fail "testSocketsF: bad socket address size for socket A")-  portA <- case S.decodeSocketAddressInternet expectedSockAddrA of-    Nothing -> fail "testSocketsF: not a sockaddr_in"-    Just (S.SocketAddressInternet {S.port}) -> pure port-  b <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind b (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))-  threadWaitWrite b-  bytesSent <- demand =<< S.uninterruptibleSendToByteArray b sample 0 5 mempty (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))-  when (bytesSent /= 5) (fail "testSocketsF: bytesSent was wrong")-  threadWaitRead a-  actual <- demand =<< S.uninterruptibleReceiveMessageB a 5 2 mempty 128-  (expectedSzB,expectedSockAddrB) <- demand =<< S.uninterruptibleGetSocketName b 128-  when (expectedSzB > 128) (fail "testSocketsF: bad socket address size for socket B")-  (expectedSzB,expectedSockAddrB,5,E.fromList [sample]) @=? actual--testSocketsG :: Assertion-testSocketsG = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol-  _ <- forkIO $ do-    bytesSent <- demand =<< S.writeVector b-      ( E.fromList-        [ E.fromList (enumFromTo (1 :: Word8) 6)-        , E.fromList (enumFromTo (7 :: Word8) 9)-        ]-      )-    when (bytesSent /= 9) (fail "testSocketsG: bytesSent was wrong")-  actual <- demand =<< S.receiveByteArray a 9 mempty-  E.fromList (enumFromTo (1 :: Word8) 9) @=? actual--testLinuxSocketsA :: Assertion-testLinuxSocketsA = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol-  threadWaitWrite b-  bytesSent1 <- demand =<< S.uninterruptibleSendByteArray b sample 0 5 mempty-  threadWaitWrite b-  bytesSent2 <- demand =<< S.uninterruptibleSendByteArray b sample2 0 4 mempty-  when (bytesSent1 /= 5) (fail "testLinuxSocketsA: bytesSent1 was wrong")-  when (bytesSent2 /= 4) (fail "testLinuxSocketsA: bytesSent2 was wrong")-  threadWaitRead a-  actual <- demand =<< L.uninterruptibleReceiveMultipleMessageA a 6 3 L.dontWait-  (5,E.fromList [sample,sample2]) @=? actual--testLinuxSocketsB :: Assertion-testLinuxSocketsB = do-  a <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind a (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))-  (expectedSzA,expectedSockAddrA) <- demand-    =<< S.uninterruptibleGetSocketName a 128-  when (expectedSzA /= S.sizeofSocketAddressInternet)-    (fail "testLinixSocketsB: bad socket address size for socket A")-  portA <- case S.decodeSocketAddressInternet expectedSockAddrA of-    Nothing -> fail "testLinixSocketsB: not a sockaddr_in"-    Just (S.SocketAddressInternet {S.port}) -> pure port-  b <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind b-    (S.encodeSocketAddressInternet $ S.SocketAddressInternet-      { S.port = 0-      , S.address = localhost-      }-    )-  threadWaitWrite b-  bytesSent1 <- demand =<< S.uninterruptibleSendToByteArray b sample 0 5 mempty-    (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))-  when (bytesSent1 /= 5)-    (fail "testLinixSocketsB: bytesSent1 was wrong")-  threadWaitWrite b-  bytesSent2 <- demand =<< S.uninterruptibleSendToByteArray b sample2 0 4 mempty-    (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))-  when (bytesSent2 /= 4)-    (fail "testLinixSocketsB: bytesSent2 was wrong")-  threadWaitRead a-  actual <- demand-    =<< L.uninterruptibleReceiveMultipleMessageB a S.sizeofSocketAddressInternet 6 3 L.dontWait-  (expectedSzB,S.SocketAddress sabytesB) <- demand =<< S.uninterruptibleGetSocketName b 128-  when (expectedSzB /= S.sizeofSocketAddressInternet)-    (fail "testLinixSocketsB: bad socket address size for socket B")-  (0,sabytesB <> sabytesB,5,E.fromList [sample,sample2]) @=? actual--testLinuxSocketsC :: Assertion-testLinuxSocketsC = do-  a <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind a (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = 0, S.address = localhost}))-  (expectedSzA,expectedSockAddrA) <- demand-    =<< S.uninterruptibleGetSocketName a 128-  when (expectedSzA /= S.sizeofSocketAddressInternet)-    (fail "testLinuxSocketsC: bad socket address size for socket A")-  portA <- case S.decodeSocketAddressInternet expectedSockAddrA of-    Nothing -> fail "testLinuxSocketsC: not a sockaddr_in"-    Just (S.SocketAddressInternet {S.port}) -> pure port-  b <- demand =<< S.uninterruptibleSocket S.Internet S.datagram S.defaultProtocol-  demand =<< S.uninterruptibleBind b-    (S.encodeSocketAddressInternet $ S.SocketAddressInternet-      { S.port = 0-      , S.address = localhost-      }-    )-  threadWaitWrite b-  bytesSent1 <- demand =<< S.uninterruptibleSendToByteArray b sample 0 5 mempty-    (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))-  when (bytesSent1 /= 5)-    (fail "testLinuxSocketsC: bytesSent1 was wrong")-  threadWaitWrite b-  bytesSent2 <- demand =<< S.uninterruptibleSendToByteArray b sample2 0 4 mempty-    (S.encodeSocketAddressInternet (S.SocketAddressInternet {S.port = portA, S.address = localhost}))-  when (bytesSent2 /= 4)-    (fail "testLinuxSocketsC: bytesSent2 was wrong")-  threadWaitRead a-  lens <- PM.newPrimArray 2-  addrs <- PM.newPrimArray 2-  payloadsMut <- PM.unsafeNewUnliftedArray 2-  PM.newByteArray 6 >>= PM.writeUnliftedArray payloadsMut 0-  PM.newByteArray 6 >>= PM.writeUnliftedArray payloadsMut 1-  msgCount <- demand =<< L.uninterruptibleReceiveMultipleMessageC a lens addrs payloadsMut 2 L.dontWait-  when (msgCount /= 2) (fail "wrong number of messages")-  addrsFrozen <- PM.unsafeFreezePrimArray addrs-  payloads <- PM.unsafeFreezeUnliftedArray payloadsMut-  len0 <- PM.readPrimArray lens 0-  len1 <- PM.readPrimArray lens 1-  buf0 <- PM.unsafeFreezeByteArray-    =<< PM.resizeMutableByteArray (PM.indexUnliftedArray payloads 0) (fromIntegral @CInt @Int len0)-  buf1 <- PM.unsafeFreezeByteArray-    =<< PM.resizeMutableByteArray (PM.indexUnliftedArray payloads 1) (fromIntegral @CInt @Int len1)-  (expectedSzB,S.SocketAddress sabytesB) <- demand =<< S.uninterruptibleGetSocketName b 128-  when (expectedSzB /= S.sizeofSocketAddressInternet)-    (fail "testLinuxSocketsC: bad socket address size for socket B")-  let primSockAddr = case sabytesB of PM.ByteArray x -> PM.PrimArray x-  (primSockAddr <> primSockAddr,E.fromList [sample,sample2]) @=? (addrsFrozen,[buf0,buf1])- -- This test opens two datagram sockets and send a message from each -- one to the other. Then it checks that epoll's event-triggered -- interface correctly notifies the user about the read-readiness -- that has happened. testLinuxEpollA :: Assertion testLinuxEpollA = do-  (a,b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol+  (a, b) <- demand =<< S.uninterruptibleSocketPair S.Unix S.datagram S.defaultProtocol   epfd <- demand =<< Epoll.uninterruptibleCreate 1   reg <- PM.newPrimArray 1-  PM.writePrimArray reg 0 $ Epoll.Event-    { Epoll.events = Epoll.input <> Epoll.edgeTriggered-    , Epoll.payload = a-    }+  PM.writePrimArray reg 0 $+    Epoll.Event+      { Epoll.events = Epoll.input <> Epoll.edgeTriggered+      , Epoll.payload = a+      }   demand =<< Epoll.uninterruptibleControlMutablePrimArray epfd Epoll.add a reg-  PM.writePrimArray reg 0 $ Epoll.Event-    { Epoll.events = Epoll.input <> Epoll.edgeTriggered-    , Epoll.payload = b-    }+  PM.writePrimArray reg 0 $+    Epoll.Event+      { Epoll.events = Epoll.input <> Epoll.edgeTriggered+      , Epoll.payload = b+      }   demand =<< Epoll.uninterruptibleControlMutablePrimArray epfd Epoll.add b reg   threadWaitWrite b   bytesSentB <- demand =<< S.uninterruptibleSendByteArray b sample 0 5 mempty@@ -287,13 +142,13 @@   when (evCount /= 2) (fail ("testLinuxEpollA: evCount was " ++ show evCount))   r <- case () of     _ -> do-      Epoll.Event{Epoll.events,Epoll.payload} <- PM.readPrimArray evs 0+      Epoll.Event {Epoll.events, Epoll.payload} <- PM.readPrimArray evs 0       when (payload /= a && payload /= b) (fail ("testLinuxEpollA: payload x was " ++ show payload))       let Epoll.Events e = events       when (not (Epoll.containsAnyEvents events Epoll.input)) $ do         fail ("testLinuxEpollA: events x bitmask " ++ showIntAtBase 2 binChar e " missing EPOLLIN")       pure payload-  Epoll.Event{Epoll.events,Epoll.payload} <- PM.readPrimArray evs 1+  Epoll.Event {Epoll.events, Epoll.payload} <- PM.readPrimArray evs 1   when (payload == r) (fail ("testLinuxEpollA: same payload " ++ show payload ++ " for both events"))   when (payload /= a && payload /= b) (fail ("testLinuxEpollA: payload y was " ++ show payload))   let Epoll.Events e = events@@ -311,25 +166,20 @@ loadGarbage (MutablePrimArray x) = do   let arr = MutableByteArray x       go :: Int -> IO ()-      go !ix = if ix > (-1)-        then do-          PM.writeByteArray arr ix ((0b01010101 :: Word8) + fromIntegral ix)-          go (ix - 1)-        else pure ()+      go !ix =+        if ix > (-1)+          then do+            PM.writeByteArray arr ix ((0b01010101 :: Word8) + fromIntegral ix)+            go (ix - 1)+          else pure ()   n <- PM.getSizeofMutableByteArray arr   go (n - 1)  sample :: ByteArray-sample = E.fromList [1,2,3,4,5]--sample2 :: ByteArray-sample2 = E.fromList [6,7,8,9]+sample = E.fromList [1, 2, 3, 4, 5]  demand :: Either Errno a -> IO a demand = either (\e -> ioError (errnoToIOError "test" e Nothing Nothing)) pure-  + oneWord :: CSize -> IO () oneWord x = if x == fromIntegral (PM.sizeOf (undefined :: Int)) then pure () else fail "expected one machine word"--localhost :: Word32-localhost = S.hostToNetworkLong 2130706433