network-unexceptional (empty) → 0.1.0.0

raw patch · 6 files changed

+206/−0 lines, 6 filesdep +basedep +byteslicedep +error-codes

Dependencies added: base, byteslice, error-codes, network, posix-api, primitive

Files

CHANGELOG.md +5/−0
LICENSE +30/−0
network-unexceptional.cabal +27/−0
src/Network/Unexceptional/Bytes.hs +68/−0
src/Network/Unexceptional/Chunks.hs +24/−0
src/Network/Unexceptional/MutableBytes.hs +52/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+# Revision history for network-unexceptional++## 0.1.0.0 -- YYYY-mm-dd++* First version.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2023, Andrew Martin++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Andrew Martin nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ network-unexceptional.cabal view

@@ -0,0 +1,27 @@+cabal-version: 3.0+name: network-unexceptional+version: 0.1.0.0+synopsis: Network functions that do not throw exceptions+license: BSD-3-Clause+license-file: LICENSE+author: Andrew Martin+maintainer: andrew.thaddeus@gmail.com+copyright: 2023 Andrew Martin+build-type: Simple+extra-doc-files: CHANGELOG.md++library+  ghc-options: -O2 -Wall+  exposed-modules:+    Network.Unexceptional.Bytes+    Network.Unexceptional.Chunks+    Network.Unexceptional.MutableBytes+  build-depends:+    , base >=4.17 && <5+    , posix-api >=0.6.0.1+    , error-codes >=0.1.1+    , byteslice >=0.2.8+    , network >=3.1+    , primitive >=0.8+  hs-source-dirs: src+  default-language: Haskell2010

+ src/Network/Unexceptional/Bytes.hs view

@@ -0,0 +1,68 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language PatternSynonyms #-}+{-# language LambdaCase #-}+{-# language NamedFieldPuns #-}++module Network.Unexceptional.Bytes+  ( send+  , receive+  ) where++import System.Posix.Types (Fd(Fd))+import Foreign.C.Error (Errno)+import Foreign.C.Types (CInt)+import Network.Socket (Socket)+import Data.Bytes.Types (Bytes(Bytes),MutableBytes(MutableBytes))+import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)+import Data.Array.Byte (ByteArray)+import GHC.Conc (threadWaitRead, threadWaitWrite)+import Control.Monad (when)++import qualified Posix.Socket as X+import qualified Linux.Socket as X+import qualified Data.Bytes.Types+import qualified Network.Socket as S+import qualified Data.Primitive as PM+import qualified Network.Unexceptional.MutableBytes as MB++-- | Send the entire byte sequence. This call POSIX @send@ in a loop+-- until all of the bytes have been sent.+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++-- does not wait for file descriptor to be ready+sendLoop :: Fd -> ByteArray -> Int -> Int -> IO (Either Errno ())+sendLoop !fd !arr !off !len =+  X.uninterruptibleSendByteArray fd arr off (fromIntegral len) (X.noSignal <> X.dontWait) >>= \case+    Left e -> if e == EAGAIN || e == EWOULDBLOCK+      then do+        threadWaitWrite fd+        sendLoop fd arr off len+      else pure (Left e)+    Right sentSzC ->+      let sentSz = fromIntegral sentSzC :: Int+       in case compare sentSz len of+            EQ -> pure (Right ())+            LT -> sendLoop fd arr (off + sentSz) (len - sentSz)+            GT -> fail "Network.Unexceptional.Bytes.sendAll: send claimed to send too many bytes"++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))

+ src/Network/Unexceptional/Chunks.hs view

@@ -0,0 +1,24 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language PatternSynonyms #-}+{-# language LambdaCase #-}+{-# language NamedFieldPuns #-}++module Network.Unexceptional.Chunks+  ( send+  ) where++import Foreign.C.Error (Errno)+import Network.Socket (Socket)+import Data.Bytes.Chunks (Chunks)++import qualified Data.Bytes.Chunks as Chunks+import qualified Network.Unexceptional.Bytes as NB++-- | Send the entire byte sequence. This call POSIX @send@ in a loop+-- until all of the bytes have been sent.+send ::+     Socket+  -> Chunks+  -> IO (Either Errno ())+send !s cs = NB.send s (Chunks.concat cs)

+ src/Network/Unexceptional/MutableBytes.hs view

@@ -0,0 +1,52 @@+{-# language BangPatterns #-}+{-# language DuplicateRecordFields #-}+{-# language PatternSynonyms #-}+{-# language LambdaCase #-}+{-# language NamedFieldPuns #-}++module Network.Unexceptional.MutableBytes+  ( receive+  ) where++import Data.Bytes.Types (MutableBytes(MutableBytes))+import Data.Primitive (MutableByteArray)+import Foreign.C.Error (Errno)+import Foreign.C.Error.Pattern (pattern EWOULDBLOCK,pattern EAGAIN)+import GHC.Conc (threadWaitRead)+import GHC.Exts (RealWorld)+import Network.Socket (Socket)+import System.Posix.Types (Fd(Fd))++import qualified Data.Bytes.Types+import qualified Linux.Socket as X+import qualified Network.Socket as S+import qualified Posix.Socket as X++-- | Receive bytes from a socket. Receives at most N bytes, where N+-- is the size of the buffer. Returns the number of bytes that were+-- actually received.+receive ::+     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++-- Does not wait for file descriptor to be ready. Only performs+-- a single successful recv syscall+receiveLoop :: Fd -> MutableByteArray RealWorld -> Int -> Int -> IO (Either Errno Int)+receiveLoop !fd !arr !off !len =+  X.uninterruptibleReceiveMutableByteArray fd arr off (fromIntegral len) X.dontWait >>= \case+    Left e -> if e == EAGAIN || e == EWOULDBLOCK+      then do+        threadWaitRead fd+        receiveLoop fd arr off len+      else pure (Left e)+    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"+            _ -> pure (Right recvSz)