packages feed

network-unexceptional 0.1.3.1 → 0.2.0.0

raw patch · 5 files changed

+143/−27 lines, 5 filesdep ~error-codes

Dependency ranges changed: error-codes

Files

CHANGELOG.md view
@@ -1,5 +1,13 @@ # Revision history for network-unexceptional +## 0.2.0.0 -- 2023-09-18++* Receive functions now fail with `EEOI` when the peer shuts down.+  This is a considerable deviation from POSIX, which returns a+  length of zero when the peer shuts down. It is much easier to write+  code using "receive" functions when a shutdown is treated as an+  exception in this way.+ ## 0.1.3.1 -- 2023-08-31  * Import `ByteArray` from `Data.Primitive` instead of `Data.Array.Byte`
network-unexceptional.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: network-unexceptional-version: 0.1.3.1+version: 0.2.0.0 synopsis: Network functions that do not throw exceptions description:   Functions compatible with the Socket type from the network library that@@ -28,7 +28,7 @@   build-depends:     , base >=4.16.3 && <5     , posix-api >=0.7-    , error-codes >=0.1.1+    , error-codes >=0.1.3     , byteslice >=0.2.8     , network >=3.1     , primitive >=0.8
src/Network/Unexceptional/ByteArray.hs view
@@ -27,22 +27,14 @@ import qualified Network.Unexceptional.MutableBytes as MB  -- | Blocks until an exact number of bytes has been received.-receiveExactly :: +receiveExactly ::      Socket   -> Int -- ^ Exact number of bytes to receive, must be greater than zero   -> IO (Either Errno ByteArray)-receiveExactly s n = if n > 0-  then do-    dst <- PM.newByteArray n-    let loop !ix !remaining = case remaining of-          0 -> do-            dst' <- PM.unsafeFreezeByteArray dst -            pure (Right dst')-          _ -> MB.receive s (MutableBytes dst ix remaining) >>= \case-            Left e -> pure (Left e)-            Right k -> loop (ix + k) (remaining - k)-    loop 0 n-  else throwIO Types.NonpositiveReceptionSize---+receiveExactly !s !n = do+  dst <- PM.newByteArray n+  MB.receiveExactly s (MutableBytes dst 0 n) >>= \case+    Left e -> pure (Left e)+    Right _ -> do+      dst' <- PM.unsafeFreezeByteArray dst+      pure (Right dst')
src/Network/Unexceptional/ByteString.hs view
@@ -7,17 +7,24 @@  module Network.Unexceptional.ByteString   ( send+  , sendInterruptible   , receive+  , receiveExactly+  , receiveExactlyInterruptible   ) where +import Control.Applicative ((<|>))+import Control.Concurrent.STM (STM,TVar)+import GHC.Conc (threadWaitWrite,threadWaitWriteSTM) import Control.Monad (when)+import Control.Monad ((<=<)) import Data.ByteString.Internal (ByteString(BS)) import Data.Bytes.Types (MutableBytes(MutableBytes))+import Data.Functor (($>)) import Data.Primitive (ByteArray(ByteArray)) import Data.Primitive.Addr (Addr(Addr),plusAddr) import Foreign.C.Error (Errno) import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)-import GHC.Conc (threadWaitWrite) import GHC.ForeignPtr (ForeignPtr(ForeignPtr),ForeignPtrContents(PlainPtr)) import Network.Socket (Socket) import System.Posix.Types (Fd(Fd))@@ -29,6 +36,7 @@ import qualified Network.Socket as S import qualified Network.Unexceptional.MutableBytes as MB import qualified Posix.Socket as X+import qualified Control.Concurrent.STM as STM  -- | Send the entire byte sequence. This call POSIX @send@ in a loop -- until all of the bytes have been sent.@@ -59,9 +67,39 @@             LT -> sendLoop fd (plusAddr addr sentSz) (len - sentSz)             GT -> fail "Network.Unexceptional.ByteString.sendLoop: send claimed to send too many bytes" +-- | Send the entire byte sequence. This call POSIX @send@ in a loop+-- until all of the bytes have been sent.+sendInterruptible ::+     TVar Bool+  -> Socket+  -> ByteString+  -> IO (Either Errno ())+sendInterruptible !interrupt  s !b =+  S.withFdSocket s $ \fd -> ByteString.unsafeUseAsCStringLen b $ \(PM.Ptr ptr,len) ->+  -- We attempt the first send without testing if the socket is in+  -- ready for writes. This is because it is uncommon for the transmit+  -- buffer to already be full.+  sendInterruptibleLoop interrupt (Fd fd) (Addr ptr) len++-- does not wait for file descriptor to be ready+sendInterruptibleLoop :: TVar Bool -> Fd -> Addr -> Int -> IO (Either Errno ())+sendInterruptibleLoop !interrupt !fd !addr !len =+  X.uninterruptibleSend fd addr (fromIntegral len) (X.noSignal <> X.dontWait) >>= \case+    Left e -> if e == EAGAIN || e == EWOULDBLOCK+      then waitUntilWriteable interrupt fd >>= \case+        Ready -> sendInterruptibleLoop interrupt fd addr len+        Interrupted -> pure (Left EAGAIN)+      else pure (Left e)+    Right sentSzC ->+      let sentSz = fromIntegral sentSzC :: Int+       in case compare sentSz len of+            EQ -> pure (Right ())+            LT -> sendInterruptibleLoop interrupt fd (plusAddr addr sentSz) (len - sentSz)+            GT -> fail "Network.Unexceptional.ByteString.sendInterruptibleLoop: send claimed to send too many bytes"+ -- | If this returns zero bytes, it means that the peer has -- performed an orderly shutdown.-receive :: +receive ::      Socket   -> Int -- ^ Maximum number of bytes to receive   -> IO (Either Errno ByteString)@@ -71,6 +109,44 @@     Left e -> pure (Left e)     Right m -> do       when (m < n) (PM.shrinkMutableByteArray dst m)-      ByteArray dst# <- PM.unsafeFreezeByteArray dst +      ByteArray dst# <- PM.unsafeFreezeByteArray dst       pure (Right (BS (ForeignPtr (Exts.byteArrayContents# dst#) (PlainPtr (Exts.unsafeCoerce# dst#))) m)) +-- | Blocks until an exact number of bytes has been received.+receiveExactly ::+     Socket+  -> Int -- ^ Exact number of bytes to receive, must be greater than zero+  -> IO (Either Errno ByteString)+receiveExactly !s !n = do+  dst <- PM.newPinnedByteArray n+  MB.receiveExactly s (MutableBytes dst 0 n) >>= \case+    Left e -> pure (Left e)+    Right _ -> do+      ByteArray dst# <- PM.unsafeFreezeByteArray dst+      pure (Right (BS (ForeignPtr (Exts.byteArrayContents# dst#) (PlainPtr (Exts.unsafeCoerce# dst#))) n))++-- | Blocks until an exact number of bytes has been received.+receiveExactlyInterruptible ::+     TVar Bool+  -> Socket+  -> Int -- ^ Exact number of bytes to receive, must be greater than zero+  -> IO (Either Errno ByteString)+receiveExactlyInterruptible !intr !s !n = do+  dst <- PM.newPinnedByteArray n+  MB.receiveExactlyInterruptible intr s (MutableBytes dst 0 n) >>= \case+    Left e -> pure (Left e)+    Right _ -> do+      ByteArray dst# <- PM.unsafeFreezeByteArray dst+      pure (Right (BS (ForeignPtr (Exts.byteArrayContents# dst#) (PlainPtr (Exts.unsafeCoerce# dst#))) n))++waitUntilWriteable :: TVar Bool -> Fd -> IO Outcome+waitUntilWriteable !interrupt !fd = do+  (isReadyAction,deregister) <- threadWaitWriteSTM fd+  outcome <- STM.atomically $ (isReadyAction $> Ready) <|> (checkFinished interrupt $> Interrupted)+  deregister+  pure outcome++data Outcome = Ready | Interrupted++checkFinished :: TVar Bool -> STM ()+checkFinished = STM.check <=< STM.readTVar
src/Network/Unexceptional/MutableBytes.hs view
@@ -7,6 +7,8 @@ module Network.Unexceptional.MutableBytes   ( receive   , receiveInterruptible+  , receiveExactly+  , receiveExactlyInterruptible   ) where  import Control.Applicative ((<|>))@@ -18,6 +20,7 @@ import Data.Primitive (MutableByteArray) import Foreign.C.Error (Errno) import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)+import Foreign.C.Error.Pattern (pattern EEOI) import GHC.Conc (threadWaitRead,threadWaitReadSTM) import GHC.Exts (RealWorld) import Network.Socket (Socket)@@ -70,9 +73,11 @@       else pure (Left e)     Right recvSzC ->       let recvSz = fromIntegral recvSzC :: Int-       in case compare recvSz len of-            GT -> throwIO Types.ReceivedTooManyBytes-            _ -> pure (Right recvSz)+       in case recvSz of+            0 -> pure (Left EEOI)+            _ -> case compare recvSz len of+              GT -> throwIO Types.ReceivedTooManyBytes+              _ -> pure (Right recvSz)  -- Does not wait for file descriptor to be ready. Only performs -- a single successful recv syscall@@ -86,9 +91,11 @@       else pure (Left e)     Right recvSzC ->       let recvSz = fromIntegral recvSzC :: Int-       in case compare recvSz len of-            GT -> throwIO Types.ReceivedTooManyBytes-            _ -> pure (Right recvSz)+       in case recvSz of+            0 -> pure (Left EEOI)+            _ -> case compare recvSz len of+              GT -> throwIO Types.ReceivedTooManyBytes+              _ -> pure (Right recvSz)  checkFinished :: TVar Bool -> STM () checkFinished = STM.check <=< STM.readTVar@@ -102,3 +109,36 @@   deregister   pure outcome +-- | Blocks until an exact number of bytes has been received.+receiveExactly ::+     Socket+  -> MutableBytes RealWorld+     -- ^ Length is the exact number of bytes to receive,+     -- must be greater than zero.+  -> IO (Either Errno ())+receiveExactly s (MutableBytes dst off0 n) = if n > 0+  then do+    let loop !ix !remaining = case remaining of+          0 -> pure (Right ())+          _ -> receive s (MutableBytes dst ix remaining) >>= \case+            Left e -> pure (Left e)+            Right k -> loop (ix + k) (remaining - k)+    loop off0 n+  else throwIO Types.NonpositiveReceptionSize++receiveExactlyInterruptible ::+     TVar Bool+  -> Socket+  -> MutableBytes RealWorld+     -- ^ Length is the exact number of bytes to receive,+     -- must be greater than zero.+  -> IO (Either Errno ())+receiveExactlyInterruptible !intr !s (MutableBytes dst off0 n) = if n > 0+  then do+    let loop !ix !remaining = case remaining of+          0 -> pure (Right ())+          _ -> receiveInterruptible intr s (MutableBytes dst ix remaining) >>= \case+            Left e -> pure (Left e)+            Right k -> loop (ix + k) (remaining - k)+    loop off0 n+  else throwIO Types.NonpositiveReceptionSize