network-transport 0.4.4.0 → 0.5.9
raw patch · 6 files changed
Files
- ChangeLog +41/−0
- Setup.hs +0/−2
- network-transport.cabal +35/−22
- src/Network/Transport.hs +0/−1
- src/Network/Transport/Internal.hs +76/−41
- src/Network/Transport/Util.hs +10/−15
ChangeLog view
@@ -1,3 +1,44 @@+2025-02-04 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.5.9++* Prevent asynchronous exceptions from `Network.Transport.Util.spawn` (#42).+* Addressed some compilation warnings (#467)++2024-09-03 Laurent P. René de Cotret <laurent.decotret@outlook.com> 0.5.8++* Bumped dependency bounds to support GHC 8.10.7 - GHC 9.10.1+* Updated links to point to Distributed Haskell monorepo++2024-03-25 David Simmons-Duffin <dsd@caltech.edu> 0.5.7++* Bump bytestring and deepseq versions to build with GHC 9.8.++2022-08-30 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.6++* Fix extension fields in the cabal file (#41).++2022-08-09 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.5++* Relax dependency bounds to build with ghc9 (#40).++2019-05-12 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.4++* Fix documentation typo (#39).++2019-05-12 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.3++* Relax upper bound of hashable.++2017-07-25 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.2++* prependLength checks for overflow (5608f0f)+* Drop inlinePerformIO for unsafeDupablePerformIO (18bf80c)+* Have travis build n-t even with no tests (7ffe43e)++2017-02-23 Facundo Domínguez <facundo.dominguez@tweag.io> 0.5.1++* Add {encode|decode}{Word|Enum|Num}{32|16}.+* Removed {encode|decode}Int{32|16}+ 2016-01-28 Facundo Domínguez <facundo.dominguez@tweag.io> 0.4.4.0 * Add compatibility with ghc-8.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
network-transport.cabal view
@@ -1,15 +1,15 @@+cabal-version: 3.0 Name: network-transport-Version: 0.4.4.0-Cabal-Version: >=1.6+Version: 0.5.9 Build-Type: Simple-License: BSD3+License: BSD-3-Clause License-File: LICENSE Copyright: Well-Typed LLP Author: Duncan Coutts, Nicolas Wu, Edsko de Vries-Maintainer: Facundo Domínguez <facundo.dominguez@tweag.io>+maintainer: The Distributed Haskell team Stability: experimental-Homepage: http://haskell-distributed.github.com-Bug-Reports: https://github.com/haskell-distributed/network-transport/issues+Homepage: https://haskell-distributed.github.io+Bug-Reports: https://github.com/haskell-distributed/distributed-process/issues Synopsis: Network abstraction layer Description: "Network.Transport" is a Network Abstraction Layer which provides the following high-level concepts:@@ -23,7 +23,7 @@ using the 'EndPointAddress' of the remote end. . * The 'EndPointAddress' can be serialised and sent over the- network, where as 'EndPoint's and connections cannot.+ network, whereas 'EndPoint's and connections cannot. . * Connections between 'EndPoint's are unidirectional and lightweight. .@@ -55,33 +55,46 @@ This package provides the generic interface only; you will probably also want to install at least one transport implementation (network-transport-*).-Tested-With: GHC==7.6.3 GHC==7.8.4 GHC==7.10.3+tested-with: GHC==8.10.7 GHC==9.0.2 GHC==9.2.8 GHC==9.4.5 GHC==9.6.4 GHC==9.8.2 GHC==9.10.1 GHC==9.12.1 Category: Network-extra-source-files: ChangeLog+extra-doc-files: ChangeLog -Source-Repository head+source-repository head Type: git- Location: https://github.com/haskell-distributed/network-transport+ Location: https://github.com/haskell-distributed/distributed-process+ SubDir: packages/network-transport +common warnings+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wredundant-constraints+ -fhide-source-paths+ -Wpartial-fields+ -Wunused-packages+ Library- Build-Depends: base >= 4.3 && < 5,- binary >= 0.5 && < 0.9,- bytestring >= 0.9 && < 0.11,- hashable >= 1.2.0.5 && < 1.3,- transformers >= 0.2 && < 0.6,- deepseq >= 1.0 && < 1.5- if impl(ghc < 7.6)- Build-Depends: ghc-prim >= 0.2 && < 0.4- Exposed-Modules: Network.Transport,+ import: warnings+ Build-Depends: base >= 4.14 && < 5,+ binary >= 0.8 && < 0.9,+ bytestring >= 0.10 && < 0.13,+ hashable >= 1.2.0.5 && < 1.6,+ transformers >= 0.2 && < 0.7,+ deepseq >= 1.0 && < 1.7+ Exposed-Modules: Network.Transport Network.Transport.Util Network.Transport.Internal- Extensions: ForeignFunctionInterface,+ Other-Extensions: ForeignFunctionInterface+ Default-Extensions: RankNTypes, ScopedTypeVariables, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP- GHC-Options: -Wall -fno-warn-unused-do-bind+ GHC-Options: -fno-warn-unused-do-bind HS-Source-Dirs: src+ Default-Language: Haskell2010 if os(win32) extra-libraries: ws2_32
src/Network/Transport.hs view
@@ -29,7 +29,6 @@ import qualified Data.ByteString.Char8 as BSC (unpack) import Control.DeepSeq (NFData(rnf)) import Control.Exception (Exception)-import Control.Applicative ((<$>)) import Data.Typeable (Typeable) import Data.Binary (Binary(..)) import Data.Hashable
src/Network/Transport/Internal.hs view
@@ -1,10 +1,15 @@+{-# LANGUAGE CPP #-} -- | Internal functions module Network.Transport.Internal ( -- * Encoders/decoders- encodeInt32- , decodeInt32- , encodeInt16- , decodeInt16+ encodeWord32+ , decodeWord32+ , encodeEnum32+ , decodeNum32+ , encodeWord16+ , decodeWord16+ , encodeEnum16+ , decodeNum16 , prependLength -- * Miscellaneous abstractions , mapIOException@@ -19,20 +24,16 @@ , tlog ) where -#if ! MIN_VERSION_base(4,6,0)-import Prelude hiding (catch)-#endif- import Foreign.Storable (pokeByteOff, peekByteOff)-import Foreign.C (CInt(..), CShort(..)) import Foreign.ForeignPtr (withForeignPtr) import Data.ByteString (ByteString)+import Data.List(foldl') import qualified Data.ByteString as BS (length) import qualified Data.ByteString.Internal as BSI ( unsafeCreate , toForeignPtr- , inlinePerformIO )+import Data.Word (Word32, Word16) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Exception ( IOException@@ -48,62 +49,96 @@ import Control.Concurrent (ThreadId, forkIO) import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, putMVar) import GHC.IO (unsafeUnmask)+import System.IO.Unsafe (unsafeDupablePerformIO) import System.Timeout (timeout) --import Control.Concurrent (myThreadId) #ifdef mingw32_HOST_OS -foreign import stdcall unsafe "htonl" htonl :: CInt -> CInt-foreign import stdcall unsafe "ntohl" ntohl :: CInt -> CInt-foreign import stdcall unsafe "htons" htons :: CShort -> CShort-foreign import stdcall unsafe "ntohs" ntohs :: CShort -> CShort+foreign import stdcall unsafe "htonl" htonl :: Word32 -> Word32+foreign import stdcall unsafe "ntohl" ntohl :: Word32 -> Word32+foreign import stdcall unsafe "htons" htons :: Word16 -> Word16+foreign import stdcall unsafe "ntohs" ntohs :: Word16 -> Word16 #else -foreign import ccall unsafe "htonl" htonl :: CInt -> CInt-foreign import ccall unsafe "ntohl" ntohl :: CInt -> CInt-foreign import ccall unsafe "htons" htons :: CShort -> CShort-foreign import ccall unsafe "ntohs" ntohs :: CShort -> CShort+foreign import ccall unsafe "htonl" htonl :: Word32 -> Word32+foreign import ccall unsafe "ntohl" ntohl :: Word32 -> Word32+foreign import ccall unsafe "htons" htons :: Word16 -> Word16+foreign import ccall unsafe "ntohs" ntohs :: Word16 -> Word16 #endif -- | Serialize 32-bit to network byte order-encodeInt32 :: Enum a => a -> ByteString-encodeInt32 i32 =+encodeWord32 :: Word32 -> ByteString+encodeWord32 w32 = BSI.unsafeCreate 4 $ \p ->- pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)+ pokeByteOff p 0 (htonl w32) -- | Deserialize 32-bit from network byte order--- Throws an IO exception if this is not a valid integer.-decodeInt32 :: Num a => ByteString -> a-decodeInt32 bs- | BS.length bs /= 4 = throw $ userError "decodeInt32: Invalid length"- | otherwise = BSI.inlinePerformIO $ do+-- Throws an IO exception if this is not exactly 32 bits.+decodeWord32 :: ByteString -> Word32+decodeWord32 bs+ | BS.length bs /= 4 = throw $ userError "decodeWord32: not 4 bytes"+ | otherwise = unsafeDupablePerformIO $ do let (fp, offset, _) = BSI.toForeignPtr bs- withForeignPtr fp $ \p -> do- w32 <- peekByteOff p offset- return (fromIntegral . ntohl $ w32)+ withForeignPtr fp $ \p -> ntohl <$> peekByteOff p offset -- | Serialize 16-bit to network byte order-encodeInt16 :: Enum a => a -> ByteString-encodeInt16 i16 =+encodeWord16 :: Word16 -> ByteString+encodeWord16 w16 = BSI.unsafeCreate 2 $ \p ->- pokeByteOff p 0 (htons . fromIntegral . fromEnum $ i16)+ pokeByteOff p 0 (htons w16) -- | Deserialize 16-bit from network byte order--- Throws an IO exception if this is not a valid integer-decodeInt16 :: Num a => ByteString -> a-decodeInt16 bs- | BS.length bs /= 2 = throw $ userError "decodeInt16: Invalid length"- | otherwise = BSI.inlinePerformIO $ do+-- Throws an IO exception if this is not exactly 16 bits.+decodeWord16 :: ByteString -> Word16+decodeWord16 bs+ | BS.length bs /= 2 = throw $ userError "decodeWord16: not 2 bytes"+ | otherwise = unsafeDupablePerformIO $ do let (fp, offset, _) = BSI.toForeignPtr bs- withForeignPtr fp $ \p -> do- w16 <- peekByteOff p offset- return (fromIntegral . ntohs $ w16)+ withForeignPtr fp $ \p -> ntohs <$> peekByteOff p offset +-- | Encode an Enum in 32 bits by encoding its signed Int equivalent (beware+-- of truncation, an Enum may contain more than 2^32 points).+encodeEnum32 :: Enum a => a -> ByteString+encodeEnum32 = encodeWord32 . fromIntegral . fromEnum++-- | Decode any Num type from 32 bits by using fromIntegral to convert from+-- a Word32.+decodeNum32 :: Num a => ByteString -> a+decodeNum32 = fromIntegral . decodeWord32++-- | Encode an Enum in 16 bits by encoding its signed Int equivalent (beware+-- of truncation, an Enum may contain more than 2^16 points).+encodeEnum16 :: Enum a => a -> ByteString+encodeEnum16 = encodeWord16 . fromIntegral . fromEnum++-- | Decode any Num type from 16 bits by using fromIntegral to convert from+-- a Word16.+decodeNum16 :: Num a => ByteString -> a+decodeNum16 = fromIntegral . decodeWord16+ -- | Prepend a list of bytestrings with their total length+-- Will be an exception in case of overflow: the sum of the lengths of+-- the ByteStrings overflows Int, or that sum overflows Word32. prependLength :: [ByteString] -> [ByteString]-prependLength bss = encodeInt32 (sum . map BS.length $ bss) : bss+prependLength bss = case word32Length of+ Nothing -> overflow+ Just w32 -> encodeWord32 w32 : bss+ where+ intLength :: Int+ intLength = foldl' safeAdd 0 . map BS.length $ bss+ word32Length :: Maybe Word32+ word32Length = tryToEnum intLength+ -- Non-negative integer addition with overflow check.+ safeAdd :: Int -> Int -> Int+ safeAdd i j+ | r >= 0 = r+ | otherwise = overflow+ where+ r = i + j+ overflow = throw $ userError "prependLength: input is too long (overflow)" -- | Translate exceptions that arise in IO computations mapIOException :: Exception e => (IOException -> e) -> IO a -> IO a
src/Network/Transport/Util.hs view
@@ -11,23 +11,18 @@ ) import Control.Exception (throwIO) import Control.Concurrent (forkIO)-import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar) --- | Fork a new thread, create a new end point on that thread, and run the specified IO operation on that thread.+-- | Create a new end point, fork a new thread, and run the specified IO operation on that thread. -- -- Returns the address of the new end point. spawn :: Transport -> (EndPoint -> IO ()) -> IO EndPointAddress spawn transport proc = do- addrMVar <- newEmptyMVar- forkIO $ do- mEndPoint <- newEndPoint transport- case mEndPoint of- Left err ->- putMVar addrMVar (Left err)- Right endPoint -> do- putMVar addrMVar (Right (address endPoint))- proc endPoint- mAddr <- takeMVar addrMVar- case mAddr of- Left err -> throwIO err- Right addr -> return addr+ -- `newEndPoint` used to be done in a separate thread, in case it was slow.+ -- However, in this case, care must be taken to appropriately handle asynchronous exceptions.+ -- Instead, for reliability, we now create the new endpoint in this thread.+ mEndPoint <- newEndPoint transport+ case mEndPoint of+ Left err -> throwIO err+ Right endPoint -> do+ forkIO $ proc endPoint+ return $ address endPoint