packages feed

network-unexceptional 0.1.0.0 → 0.1.1.0

raw patch · 7 files changed

+209/−28 lines, 7 filesdep +bytestringdep +primitive-addrdep ~basedep ~posix-api

Dependencies added: bytestring, primitive-addr

Dependency ranges changed: base, posix-api

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@ # Revision history for network-unexceptional +## 0.1.1.0 -- 2023-08-14++* Add Network.Unexceptional module with `accept_`.+* Add Network.Unexceptional.ByteString module+ ## 0.1.0.0 -- YYYY-mm-dd  * First version.
network-unexceptional.cabal view
@@ -1,7 +1,12 @@ cabal-version: 3.0 name: network-unexceptional-version: 0.1.0.0+version: 0.1.1.0 synopsis: Network functions that do not throw exceptions+description:+  Functions compatible with the Socket type from the network library that+  do not convert POSIX error codes to thrown exceptions. This library+  can throw exceptions, but they only happen in the case of misuse, not+  as the result of anything a network peer does. license: BSD-3-Clause license-file: LICENSE author: Andrew Martin@@ -13,15 +18,20 @@ library   ghc-options: -O2 -Wall   exposed-modules:+    Network.Unexceptional     Network.Unexceptional.Bytes+    Network.Unexceptional.ByteString     Network.Unexceptional.Chunks     Network.Unexceptional.MutableBytes+    Network.Unexceptional.Types   build-depends:     , base >=4.17 && <5-    , posix-api >=0.6.0.1+    , posix-api >=0.6.1     , error-codes >=0.1.1     , byteslice >=0.2.8     , network >=3.1     , primitive >=0.8+    , primitive-addr >=0.1.0.2+    , bytestring >=0.11.4   hs-source-dirs: src   default-language: Haskell2010
+ src/Network/Unexceptional.hs view
@@ -0,0 +1,33 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language PatternSynonyms #-}+{-# language LambdaCase #-}+{-# language NamedFieldPuns #-}++module Network.Unexceptional+  ( accept_+  ) where++import Network.Socket (Socket,mkSocket,withFdSocket)+import Foreign.C.Error (Errno)+import GHC.Conc (threadWaitRead)+import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)+import System.Posix.Types (Fd(Fd))++import qualified Linux.Socket as X++-- | Accept a connection. See the documentation in @network@ for @accept@.+--+-- Note: This may leak a file descriptor if an asynchronous exception is+-- received while this function is running.+accept_ :: Socket -> IO (Either Errno Socket)+accept_ listing_sock = withFdSocket listing_sock $ \listing_fd -> do+  let acceptLoop = do+        threadWaitRead (Fd listing_fd)+        X.uninterruptibleAccept4_ (Fd listing_fd) (X.nonblocking <> X.closeOnExec) >>= \case+          Left e -> if e == EAGAIN || e == EWOULDBLOCK+            then acceptLoop+            else pure (Left e)+          Right (Fd fd) -> fmap Right (mkSocket fd)+  acceptLoop+
+ src/Network/Unexceptional/ByteString.hs view
@@ -0,0 +1,76 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language MagicHash #-}+{-# language PatternSynonyms #-}+{-# language LambdaCase #-}+{-# language NamedFieldPuns #-}++module Network.Unexceptional.ByteString+  ( send+  , receive+  ) where++import Control.Monad (when)+import Data.ByteString.Internal (ByteString(BS))+import Data.Bytes.Types (MutableBytes(MutableBytes))+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))++import qualified Data.ByteString.Unsafe as ByteString+import qualified Data.Primitive as PM+import qualified GHC.Exts as Exts+import qualified Linux.Socket as X+import qualified Network.Socket as S+import qualified Network.Unexceptional.MutableBytes as MB+import qualified Posix.Socket as X++-- | Send the entire byte sequence. This call POSIX @send@ in a loop+-- until all of the bytes have been sent.+send ::+     Socket+  -> ByteString+  -> IO (Either Errno ())+send 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.+  sendLoop (Fd fd) (Addr ptr) len++-- does not wait for file descriptor to be ready+sendLoop :: Fd -> Addr -> Int -> IO (Either Errno ())+sendLoop !fd !addr !len =+  X.uninterruptibleSend fd addr (fromIntegral len) (X.noSignal <> X.dontWait) >>= \case+    Left e -> if e == EAGAIN || e == EWOULDBLOCK+      then do+        threadWaitWrite fd+        sendLoop fd addr len+      else pure (Left e)+    Right sentSzC ->+      let sentSz = fromIntegral sentSzC :: Int+       in case compare sentSz len of+            EQ -> pure (Right ())+            LT -> sendLoop fd (plusAddr addr sentSz) (len - sentSz)+            GT -> fail "Network.Unexceptional.ByteString.sendLoop: send claimed to send too many bytes"++-- | If this returns zero bytes, it means that the peer has+-- performed an orderly shutdown.+receive :: +     Socket+  -> Int -- ^ Maximum number of bytes to receive+  -> IO (Either Errno ByteString)+receive s n = do+  dst <- PM.newPinnedByteArray n+  MB.receive s (MutableBytes dst 0 n) >>= \case+    Left e -> pure (Left e)+    Right m -> do+      when (m < n) (PM.shrinkMutableByteArray dst m)+      ByteArray dst# <- PM.unsafeFreezeByteArray dst +      pure (Right (BS (ForeignPtr (Exts.byteArrayContents# dst#) (PlainPtr (Exts.unsafeCoerce# dst#))) m))+
src/Network/Unexceptional/Bytes.hs view
@@ -9,16 +9,17 @@   , receive   ) where -import System.Posix.Types (Fd(Fd))-import Foreign.C.Error (Errno)-import Foreign.C.Types (CInt)-import Network.Socket (Socket)+import Control.Exception (throwIO)+import Control.Monad (when)+import Data.Array.Byte (ByteArray) import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes))+import Foreign.C.Error (Errno) import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)-import Data.Array.Byte (ByteArray)-import GHC.Conc (threadWaitRead, threadWaitWrite)-import Control.Monad (when)+import GHC.Conc (threadWaitWrite)+import Network.Socket (Socket)+import System.Posix.Types (Fd(Fd)) +import qualified Network.Unexceptional.Types as Types import qualified Posix.Socket as X import qualified Linux.Socket as X import qualified Data.Bytes.Types@@ -28,15 +29,20 @@  -- | Send the entire byte sequence. This call POSIX @send@ in a loop -- until all of the bytes have been sent.+--+-- If this is passed the empty byte sequence, it doesn't actually call+-- POSIX @send()@. It just returns that it succeeded. send ::      Socket   -> Bytes   -> IO (Either Errno ())-send s Bytes{array,offset,length=len} = S.withFdSocket s $ \fd ->-  -- 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.-  sendLoop (Fd fd) array offset len+send s Bytes{array,offset,length=len} = case len of+  0 -> pure (Right ())+  _ -> S.withFdSocket s $ \fd ->+    -- 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.+    sendLoop (Fd fd) array offset len  -- does not wait for file descriptor to be ready sendLoop :: Fd -> ByteArray -> Int -> Int -> IO (Either Errno ())@@ -54,15 +60,21 @@             LT -> sendLoop fd arr (off + sentSz) (len - sentSz)             GT -> fail "Network.Unexceptional.Bytes.sendAll: send claimed to send too many bytes" +-- | If this returns zero bytes, it means that the peer has+-- performed an orderly shutdown. receive ::       Socket   -> Int -- ^ Maximum number of bytes to receive   -> IO (Either Errno Bytes)-receive s n = do-  dst <- PM.newByteArray n-  MB.receive s (MutableBytes dst 0 n) >>= \case-    Left e -> pure (Left e)-    Right m -> do-      when (m < n) (PM.shrinkMutableByteArray dst m)-      dst' <- PM.unsafeFreezeByteArray dst -      pure (Right (Bytes dst' 0 m))+receive s n = if n > 0+  then do+    dst <- PM.newByteArray n+    MB.receive s (MutableBytes dst 0 n) >>= \case+      Left e -> pure (Left e)+      Right m -> do+        when (m < n) (PM.shrinkMutableByteArray dst m)+        dst' <- PM.unsafeFreezeByteArray dst +        pure (Right (Bytes dst' 0 m))+  else throwIO Types.NonpositiveReceptionSize++
src/Network/Unexceptional/MutableBytes.hs view
@@ -8,6 +8,7 @@   ( receive   ) where +import Control.Exception (throwIO) import Data.Bytes.Types (MutableBytes(MutableBytes)) import Data.Primitive (MutableByteArray) import Foreign.C.Error (Errno)@@ -17,6 +18,7 @@ import Network.Socket (Socket) import System.Posix.Types (Fd(Fd)) +import qualified Network.Unexceptional.Types as Types import qualified Data.Bytes.Types import qualified Linux.Socket as X import qualified Network.Socket as S@@ -29,11 +31,13 @@      Socket   -> MutableBytes RealWorld -- ^ Slice of a buffer   -> IO (Either Errno Int)-receive s MutableBytes{array,offset,length=len} = S.withFdSocket s $ \fd ->-  -- 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.-  receiveLoop (Fd fd) array offset len+receive s MutableBytes{array,offset,length=len} =+  if len > 0+    then S.withFdSocket s $ \fd ->+      -- We attempt the first receive without testing if the socket is+      -- ready for reads.+      receiveLoop (Fd fd) array offset len+    else throwIO Types.NonpositiveReceptionSize  -- Does not wait for file descriptor to be ready. Only performs -- a single successful recv syscall@@ -48,5 +52,5 @@     Right recvSzC ->       let recvSz = fromIntegral recvSzC :: Int        in case compare recvSz len of-            GT -> fail "Network.Unexceptional.Bytes.receive: recv claimed to receive too many bytes"+            GT -> throwIO Types.ReceivedTooManyBytes             _ -> pure (Right recvSz)
+ src/Network/Unexceptional/Types.hs view
@@ -0,0 +1,41 @@+{-# language DerivingStrategies #-}+{-# language DeriveAnyClass #-}++-- | All of the exceptions defined in this module indicate either misuse+-- of the library or an implementation mistake in the libary.+module Network.Unexceptional.Types+  ( NonpositiveReceptionSize(..)+  , ReceivedTooManyBytes(..)+  ) where++import Control.Exception (Exception)++-- | Thrown when any of the @receive@ functions are called with+-- a length less than 1. This includes zero and any negative numbers.+-- This indicates misuse of the API and is not considered a recoverable+-- exception.+--+-- Requesting a negative number is bytes is clear misuse of the API.+-- But what about zero? This deserves some justification. POSIX allows+-- requesting zero bytes with @recv@, and the result is that it copies+-- no bytes into the buffer and returns 0. Essentially, it's a no-op.+-- However, the return length 0 is also used to indicate a shutdown.+-- This overloaded meaning of the return value 0 makes it difficult to+-- interpret what it means. (It would be nice if @recv@ instead set the+-- error code to something indicating EOF when the peer had shutdown,+-- but we live in a more difficult world.) To correctly interpret the+-- meaning of return length 0, an application must consider what buffer+-- size it passed to @recv@. To prevent the caller from having to do this+-- bookkeeping, this library simply forbids requesting 0 bytes with @recv@.+-- If you do request 0 bytes with @recv@, you get this exception, and you+-- can fix the part of your program that failed to satisfy the+-- precondition.+data NonpositiveReceptionSize = NonpositiveReceptionSize+  deriving stock (Show)+  deriving anyclass (Exception)++-- | This indicates a mistake in this library. Open an issue if this+-- exception is ever thrown. +data ReceivedTooManyBytes = ReceivedTooManyBytes+  deriving stock (Show)+  deriving anyclass (Exception)