network 3.2.1.0 → 3.2.2.0
raw patch · 21 files changed
+602/−379 lines, 21 filesdep +stm
Dependencies added: stm
Files
- CHANGELOG.md +8/−0
- Network/Socket.hs +263/−129
- Network/Socket/Address.hs +19/−16
- Network/Socket/ByteString.hs +15/−16
- Network/Socket/ByteString/Lazy.hs +46/−31
- Network/Socket/ByteString/Lazy/Posix.hs +32/−26
- Network/Socket/ByteString/Lazy/Windows.hs +20/−15
- Network/Socket/Handle.hs +4/−5
- Network/Socket/Imports.hs +15/−15
- Network/Socket/ReadShow.hs +27/−25
- Network/Socket/STM.hs +24/−0
- Network/Socket/SockAddr.hs +60/−46
- Network/Socket/Types.hsc +4/−3
- configure +9/−9
- configure.ac +1/−1
- examples/EchoClient.hs +2/−1
- examples/EchoServer.hs +17/−14
- network.cabal +4/−2
- tests/BadFileDescriptor.hs +9/−8
- tests/Network/Socket/ByteString/LazySpec.hs +1/−1
- tests/Network/Socket/ByteStringSpec.hs +22/−16
CHANGELOG.md view
@@ -1,3 +1,11 @@+## Version 3.2.2.0++* New API: waitReadSocketSTM, waitAndCancelReadSocketSTM,+ waitWriteSocketSTM, waitAndCancelWriteSocketSTM+ [#586](https://github.com/haskell/network/issues/585)+* Checking the length of ASCII string allowing trailing 0.+ [#585](https://github.com/haskell/network/issues/585)+ ## Version 3.2.1.0 * Trying to release with the latest autoreconf.
Network/Socket.hs view
@@ -3,6 +3,11 @@ #include "HsNetDef.h" -----------------------------------------------------------------------------++-----------------------------------------------------------------------------++-- In order to process this file, you need to have CALLCONV defined.+ -- | -- Module : Network.Socket -- Copyright : (c) The University of Glasgow 2001@@ -100,169 +105,297 @@ -- unexpected things would happen. There is one exception for multiple -- threads vs a single 'Socket': one thread reads data from a 'Socket' -- only and the other thread writes data to the 'Socket' only.---------------------------------------------------------------------------------- In order to process this file, you need to have CALLCONV defined.--module Network.Socket- (+module Network.Socket ( -- * Initialisation- withSocketsDo+ withSocketsDo, -- * Address information- , getAddrInfo+ getAddrInfo,+ -- ** Types- , HostName- , ServiceName- , AddrInfo(..)- , defaultHints+ HostName,+ ServiceName,+ AddrInfo (..),+ defaultHints,+ -- ** Flags- , AddrInfoFlag(..)- , addrInfoFlagImplemented+ AddrInfoFlag (..),+ addrInfoFlagImplemented, -- * Socket operations- , connect- , bind- , listen- , accept+ connect,+ bind,+ listen,+ accept,+ -- ** Closing- , close- , close'- , gracefulClose- , shutdown- , ShutdownCmd(..)+ close,+ close',+ gracefulClose,+ shutdown,+ ShutdownCmd (..), -- * Socket options- , SocketOption(SockOpt- ,UnsupportedSocketOption- ,Debug,ReuseAddr,SoDomain,Type,SoProtocol,SoError,DontRoute- ,Broadcast,SendBuffer,RecvBuffer,KeepAlive,OOBInline- ,TimeToLive,MaxSegment,NoDelay,Cork,Linger,ReusePort- ,RecvLowWater,SendLowWater,RecvTimeOut,SendTimeOut- ,UseLoopBack,UserTimeout,IPv6Only- ,RecvIPv4TTL,RecvIPv4TOS,RecvIPv4PktInfo- ,RecvIPv6HopLimit,RecvIPv6TClass,RecvIPv6PktInfo)- , StructLinger (..)- , SocketTimeout (..)- , isSupportedSocketOption- , whenSupported- , getSocketOption- , setSocketOption- , getSockOpt- , setSockOpt+ SocketOption (+ SockOpt,+ UnsupportedSocketOption,+ Debug,+ ReuseAddr,+ SoDomain,+ Type,+ SoProtocol,+ SoError,+ DontRoute,+ Broadcast,+ SendBuffer,+ RecvBuffer,+ KeepAlive,+ OOBInline,+ TimeToLive,+ MaxSegment,+ NoDelay,+ Cork,+ Linger,+ ReusePort,+ RecvLowWater,+ SendLowWater,+ RecvTimeOut,+ SendTimeOut,+ UseLoopBack,+ UserTimeout,+ IPv6Only,+ RecvIPv4TTL,+ RecvIPv4TOS,+ RecvIPv4PktInfo,+ RecvIPv6HopLimit,+ RecvIPv6TClass,+ RecvIPv6PktInfo+ ),+ StructLinger (..),+ SocketTimeout (..),+ isSupportedSocketOption,+ whenSupported,+ getSocketOption,+ setSocketOption,+ getSockOpt,+ setSockOpt, -- * Socket- , Socket- , socket- , openSocket- , withFdSocket- , unsafeFdSocket- , touchSocket- , socketToFd- , fdSocket- , mkSocket- , socketToHandle+ Socket,+ socket,+ openSocket,+ withFdSocket,+ unsafeFdSocket,+ touchSocket,+ socketToFd,+ fdSocket,+ mkSocket,+ socketToHandle,+ -- ** Types of Socket- , SocketType(GeneralSocketType, UnsupportedSocketType, NoSocketType- , Stream, Datagram, Raw, RDM, SeqPacket)- , isSupportedSocketType- , getSocketType+ SocketType (+ GeneralSocketType,+ UnsupportedSocketType,+ NoSocketType,+ Stream,+ Datagram,+ Raw,+ RDM,+ SeqPacket+ ),+ isSupportedSocketType,+ getSocketType,+ -- ** Family- , Family(GeneralFamily, UnsupportedFamily- ,AF_UNSPEC,AF_UNIX,AF_INET,AF_INET6,AF_IMPLINK,AF_PUP,AF_CHAOS- ,AF_NS,AF_NBS,AF_ECMA,AF_DATAKIT,AF_CCITT,AF_SNA,AF_DECnet- ,AF_DLI,AF_LAT,AF_HYLINK,AF_APPLETALK,AF_ROUTE,AF_NETBIOS- ,AF_NIT,AF_802,AF_ISO,AF_OSI,AF_NETMAN,AF_X25,AF_AX25,AF_OSINET- ,AF_GOSSIP,AF_IPX,Pseudo_AF_XTP,AF_CTF,AF_WAN,AF_SDL,AF_NETWARE- ,AF_NDD,AF_INTF,AF_COIP,AF_CNT,Pseudo_AF_RTIP,Pseudo_AF_PIP- ,AF_SIP,AF_ISDN,Pseudo_AF_KEY,AF_NATM,AF_ARP,Pseudo_AF_HDRCMPLT- ,AF_ENCAP,AF_LINK,AF_RAW,AF_RIF,AF_NETROM,AF_BRIDGE,AF_ATMPVC- ,AF_ROSE,AF_NETBEUI,AF_SECURITY,AF_PACKET,AF_ASH,AF_ECONET- ,AF_ATMSVC,AF_IRDA,AF_PPPOX,AF_WANPIPE,AF_BLUETOOTH,AF_CAN)- , isSupportedFamily- , packFamily- , unpackFamily+ Family (+ GeneralFamily,+ UnsupportedFamily,+ AF_UNSPEC,+ AF_UNIX,+ AF_INET,+ AF_INET6,+ AF_IMPLINK,+ AF_PUP,+ AF_CHAOS,+ AF_NS,+ AF_NBS,+ AF_ECMA,+ AF_DATAKIT,+ AF_CCITT,+ AF_SNA,+ AF_DECnet,+ AF_DLI,+ AF_LAT,+ AF_HYLINK,+ AF_APPLETALK,+ AF_ROUTE,+ AF_NETBIOS,+ AF_NIT,+ AF_802,+ AF_ISO,+ AF_OSI,+ AF_NETMAN,+ AF_X25,+ AF_AX25,+ AF_OSINET,+ AF_GOSSIP,+ AF_IPX,+ Pseudo_AF_XTP,+ AF_CTF,+ AF_WAN,+ AF_SDL,+ AF_NETWARE,+ AF_NDD,+ AF_INTF,+ AF_COIP,+ AF_CNT,+ Pseudo_AF_RTIP,+ Pseudo_AF_PIP,+ AF_SIP,+ AF_ISDN,+ Pseudo_AF_KEY,+ AF_NATM,+ AF_ARP,+ Pseudo_AF_HDRCMPLT,+ AF_ENCAP,+ AF_LINK,+ AF_RAW,+ AF_RIF,+ AF_NETROM,+ AF_BRIDGE,+ AF_ATMPVC,+ AF_ROSE,+ AF_NETBEUI,+ AF_SECURITY,+ AF_PACKET,+ AF_ASH,+ AF_ECONET,+ AF_ATMSVC,+ AF_IRDA,+ AF_PPPOX,+ AF_WANPIPE,+ AF_BLUETOOTH,+ AF_CAN+ ),+ isSupportedFamily,+ packFamily,+ unpackFamily,+ -- ** Protocol number- , ProtocolNumber- , defaultProtocol+ ProtocolNumber,+ defaultProtocol,+ -- * Basic socket address type- , SockAddr(..)- , isSupportedSockAddr- , getPeerName- , getSocketName+ SockAddr (..),+ isSupportedSockAddr,+ getPeerName,+ getSocketName,+ -- ** Host address- , HostAddress- , hostAddressToTuple- , tupleToHostAddress+ HostAddress,+ hostAddressToTuple,+ tupleToHostAddress,+ -- ** Host address6- , HostAddress6- , hostAddress6ToTuple- , tupleToHostAddress6+ HostAddress6,+ hostAddress6ToTuple,+ tupleToHostAddress6,+ -- ** Flow Info- , FlowInfo+ FlowInfo,+ -- ** Scope ID- , ScopeID- , ifNameToIndex- , ifIndexToName+ ScopeID,+ ifNameToIndex,+ ifIndexToName,+ -- ** Port number- , PortNumber- , defaultPort- , socketPortSafe- , socketPort+ PortNumber,+ defaultPort,+ socketPortSafe,+ socketPort, -- * UNIX-domain socket- , isUnixDomainSocketAvailable- , socketPair- , sendFd- , recvFd- , getPeerCredential+ isUnixDomainSocketAvailable,+ socketPair,+ sendFd,+ recvFd,+ getPeerCredential, -- * Name information- , getNameInfo- , NameInfoFlag(..)+ getNameInfo,+ NameInfoFlag (..), -- * Low level+ -- ** socket operations- , setCloseOnExecIfNeeded- , getCloseOnExec- , setNonBlockIfNeeded- , getNonBlock+ setCloseOnExecIfNeeded,+ getCloseOnExec,+ setNonBlockIfNeeded,+ getNonBlock,+ -- ** Sending and receiving data- , sendBuf- , recvBuf- , sendBufTo- , recvBufFrom+ sendBuf,+ recvBuf,+ sendBufTo,+ recvBufFrom,+ -- ** Advanced IO- , sendBufMsg- , recvBufMsg- , MsgFlag(MSG_OOB,MSG_DONTROUTE,MSG_PEEK,MSG_EOR,MSG_TRUNC,MSG_CTRUNC,MSG_WAITALL)+ sendBufMsg,+ recvBufMsg,+ MsgFlag (+ MSG_OOB,+ MSG_DONTROUTE,+ MSG_PEEK,+ MSG_EOR,+ MSG_TRUNC,+ MSG_CTRUNC,+ MSG_WAITALL+ ),+ -- ** Control message (ancillary data)- , Cmsg(..)- , CmsgId(CmsgId- ,CmsgIdIPv4TTL- ,CmsgIdIPv6HopLimit- ,CmsgIdIPv4TOS- ,CmsgIdIPv6TClass- ,CmsgIdIPv4PktInfo- ,CmsgIdIPv6PktInfo- ,CmsgIdFds- ,UnsupportedCmsgId)+ Cmsg (..),+ CmsgId (+ CmsgId,+ CmsgIdIPv4TTL,+ CmsgIdIPv6HopLimit,+ CmsgIdIPv4TOS,+ CmsgIdIPv6TClass,+ CmsgIdIPv4PktInfo,+ CmsgIdIPv6PktInfo,+ CmsgIdFds,+ UnsupportedCmsgId+ ),+ -- ** APIs for control message- , lookupCmsg- , filterCmsg+ lookupCmsg,+ filterCmsg,+ -- ** Class and types for control message- , ControlMessage(..)- , IPv4TTL(..)- , IPv6HopLimit(..)- , IPv4TOS(..)- , IPv6TClass(..)- , IPv4PktInfo(..)- , IPv6PktInfo(..)+ ControlMessage (..),+ IPv4TTL (..),+ IPv6HopLimit (..),+ IPv4TOS (..),+ IPv6TClass (..),+ IPv4PktInfo (..),+ IPv6PktInfo (..),+ -- * Special constants- , maxListenQueue- ) where+ maxListenQueue, -import Network.Socket.Buffer hiding (sendBufTo, recvBufFrom, sendBufMsg, recvBufMsg)+ -- * STM to check read and write+ waitReadSocketSTM,+ waitAndCancelReadSocketSTM,+ waitWriteSocketSTM,+ waitAndCancelWriteSocketSTM,+) where++import Network.Socket.Buffer hiding (+ recvBufFrom,+ recvBufMsg,+ sendBufMsg,+ sendBufTo,+ ) import Network.Socket.Cbits import Network.Socket.Fcntl import Network.Socket.Flag@@ -272,9 +405,10 @@ import Network.Socket.Internal import Network.Socket.Name hiding (getPeerName, getSocketName) import Network.Socket.Options+import Network.Socket.STM import Network.Socket.Shutdown import Network.Socket.SockAddr-import Network.Socket.Syscall hiding (connect, bind, accept)+import Network.Socket.Syscall hiding (accept, bind, connect) import Network.Socket.Types import Network.Socket.Unix #if !defined(mingw32_HOST_OS)
Network/Socket/Address.hs view
@@ -1,28 +1,31 @@ -- | This module provides extensible APIs for socket addresses.--- module Network.Socket.Address ( -- * Socket Address- SocketAddress(..)- , getPeerName- , getSocketName+ SocketAddress (..),+ getPeerName,+ getSocketName,+ -- * Socket operations- , connect- , bind- , accept+ connect,+ bind,+ accept,+ -- * Sending and receiving ByteString- , sendTo- , sendAllTo- , recvFrom+ sendTo,+ sendAllTo,+ recvFrom,+ -- * Sending and receiving data from a buffer- , sendBufTo- , recvBufFrom+ sendBufTo,+ recvBufFrom,+ -- * Advanced IO- , sendBufMsg- , recvBufMsg- ) where+ sendBufMsg,+ recvBufMsg,+) where -import Network.Socket.ByteString.IO import Network.Socket.Buffer+import Network.Socket.ByteString.IO import Network.Socket.Name import Network.Socket.Syscall import Network.Socket.Types
Network/Socket/ByteString.hs view
@@ -16,37 +16,36 @@ -- -- > import Network.Socket -- > import Network.Socket.ByteString----module Network.Socket.ByteString- (+module Network.Socket.ByteString ( -- * Send data to a socket- send- , sendAll- , sendTo- , sendAllTo+ send,+ sendAll,+ sendTo,+ sendAllTo, -- ** Vectored I/O -- $vectored- , sendMany- , sendManyTo- , sendManyWithFds+ sendMany,+ sendManyTo,+ sendManyWithFds, -- * Receive data from a socket- , recv- , recvFrom+ recv,+ recvFrom, -- * Advanced send and recv- , sendMsg- , recvMsg- ) where+ sendMsg,+ recvMsg,+) where import Data.ByteString (ByteString) +import Network.Socket.ByteString.IO hiding (recvFrom, sendAllTo, sendTo) import qualified Network.Socket.ByteString.IO as G-import Network.Socket.ByteString.IO hiding (sendTo, sendAllTo, recvFrom) import Network.Socket.Types -- ----------------------------------------------------------------------------+ -- ** Vectored I/O -- $vectored
Network/Socket/ByteString/Lazy.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+ -- | -- Module : Network.Socket.ByteString.Lazy -- Copyright : (c) Bryan O'Sullivan 2009@@ -18,23 +19,26 @@ -- > import Network.Socket -- > import Network.Socket.ByteString.Lazy -- > import Prelude hiding (getContents)--- module Network.Socket.ByteString.Lazy ( -- * Send data to a socket- send- , sendAll- , sendWithFds+ send,+ sendAll,+ sendWithFds,+ -- * Receive data from a socket- , getContents- , recv- ) where+ getContents,+ recv,+) where -import Data.ByteString.Lazy.Internal (ByteString(..), defaultChunkSize)-import Network.Socket (ShutdownCmd (..), shutdown)-import Prelude hiding (getContents)-import System.IO.Unsafe (unsafeInterleaveIO)-import System.IO.Error (catchIOError)-import System.Posix.Types (Fd(..))+import Data.ByteString.Lazy.Internal (+ ByteString (..),+ defaultChunkSize,+ )+import Network.Socket (ShutdownCmd (..), shutdown)+import System.IO.Error (catchIOError)+import System.IO.Unsafe (unsafeInterleaveIO)+import System.Posix.Types (Fd (..))+import Prelude hiding (getContents) #if defined(mingw32_HOST_OS) import Network.Socket.ByteString.Lazy.Windows (send, sendAll)@@ -42,22 +46,27 @@ import Network.Socket.ByteString.Lazy.Posix (send, sendAll) #endif -import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L-import qualified Network.Socket.ByteString as N-import Network.Socket.Imports-import Network.Socket.Types+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L+import qualified Network.Socket.ByteString as N+import Network.Socket.Imports+import Network.Socket.Types -- | Send data and file descriptors over a UNIX-domain socket in -- a single system call. This function does not work on Windows.-sendWithFds :: Socket -- ^ Socket- -> ByteString -- ^ Data to send- -> [Fd] -- ^ File descriptors- -> IO ()+sendWithFds+ :: Socket+ -- ^ Socket+ -> ByteString+ -- ^ Data to send+ -> [Fd]+ -- ^ File descriptors+ -> IO () sendWithFds s lbs fds = N.sendManyWithFds s (L.toChunks lbs) fds -- ----------------------------------------------------------------------------- -- Receiving+ -- | Receive data from the socket. The socket must be in a connected -- state. Data is received on demand, in chunks; each chunk will be -- sized to reflect the amount of data received by individual 'recv'@@ -68,16 +77,18 @@ -- down. If there is an error and an exception is thrown, the socket -- is not shut down. getContents- :: Socket -- ^ Connected socket- -> IO ByteString -- ^ Data received+ :: Socket+ -- ^ Connected socket+ -> IO ByteString+ -- ^ Data received getContents s = loop where loop = unsafeInterleaveIO $ do sbs <- N.recv s defaultChunkSize if S.null sbs then do- shutdown s ShutdownReceive `catchIOError` const (return ())- return Empty+ shutdown s ShutdownReceive `catchIOError` const (return ())+ return Empty else Chunk sbs <$> loop -- | Receive data from the socket. The socket must be in a connected@@ -88,10 +99,14 @@ -- -- If there is no more data to be received, returns an empty 'ByteString'. recv- :: Socket -- ^ Connected socket- -> Int64 -- ^ Maximum number of bytes to receive- -> IO ByteString -- ^ Data received+ :: Socket+ -- ^ Connected socket+ -> Int64+ -- ^ Maximum number of bytes to receive+ -> IO ByteString+ -- ^ Data received recv s nbytes = chunk <$> N.recv s (fromIntegral nbytes) where- chunk k | S.null k = Empty- | otherwise = Chunk k Empty+ chunk k+ | S.null k = Empty+ | otherwise = Chunk k Empty
Network/Socket/ByteString/Lazy/Posix.hs view
@@ -2,52 +2,58 @@ module Network.Socket.ByteString.Lazy.Posix ( -- * Send data to a socket- send- , sendAll- ) where+ send,+ sendAll,+) where -import qualified Data.ByteString.Lazy as L-import Data.ByteString.Unsafe (unsafeUseAsCStringLen)-import Foreign.Marshal.Array (allocaArray)+import qualified Data.ByteString.Lazy as L+import Data.ByteString.Unsafe (unsafeUseAsCStringLen)+import Foreign.Marshal.Array (allocaArray) -import Network.Socket.ByteString.IO (waitWhen0)-import Network.Socket.ByteString.Internal (c_writev)-import Network.Socket.Imports-import Network.Socket.Internal-import Network.Socket.Posix.IOVec (IOVec (IOVec))-import Network.Socket.Types+import Network.Socket.ByteString.IO (waitWhen0)+import Network.Socket.ByteString.Internal (c_writev)+import Network.Socket.Imports+import Network.Socket.Internal+import Network.Socket.Posix.IOVec (IOVec (IOVec))+import Network.Socket.Types -- ----------------------------------------------------------------------------- -- Sending send- :: Socket -- ^ Connected socket- -> L.ByteString -- ^ Data to send- -> IO Int64 -- ^ Number of bytes sent+ :: Socket+ -- ^ Connected socket+ -> L.ByteString+ -- ^ Data to send+ -> IO Int64+ -- ^ Number of bytes sent send s lbs = do- let cs = take maxNumChunks (L.toChunks lbs)+ let cs = take maxNumChunks (L.toChunks lbs) len = length cs siz <- withFdSocket s $ \fd -> allocaArray len $ \ptr ->- withPokes cs ptr $ \niovs ->- throwSocketErrorWaitWrite s "writev" $ c_writev fd ptr niovs+ withPokes cs ptr $ \niovs ->+ throwSocketErrorWaitWrite s "writev" $ c_writev fd ptr niovs return $ fromIntegral siz where withPokes ss p f = loop ss p 0 0 where- loop (c:cs) q k niovs+ loop (c : cs) q k niovs | k < maxNumBytes = unsafeUseAsCStringLen c $ \(ptr, len) -> do poke q $ IOVec (castPtr ptr) (fromIntegral len)- loop cs- (q `plusPtr` sizeOf (IOVec nullPtr 0))- (k + fromIntegral len)- (niovs + 1)+ loop+ cs+ (q `plusPtr` sizeOf (IOVec nullPtr 0))+ (k + fromIntegral len)+ (niovs + 1) | otherwise = f niovs loop _ _ _ niovs = f niovs- maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call+ maxNumBytes = 4194304 :: Int -- maximum number of bytes to transmit in one system call maxNumChunks = 1024 :: Int -- maximum number of chunks to transmit in one system call sendAll- :: Socket -- ^ Connected socket- -> L.ByteString -- ^ Data to send+ :: Socket+ -- ^ Connected socket+ -> L.ByteString+ -- ^ Data to send -> IO () sendAll _ "" = return () sendAll s bs0 = loop bs0
Network/Socket/ByteString/Lazy/Windows.hs view
@@ -2,31 +2,36 @@ module Network.Socket.ByteString.Lazy.Windows ( -- * Send data to a socket- send- , sendAll- ) where+ send,+ sendAll,+) where -import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString as S+import qualified Data.ByteString.Lazy as L import qualified Network.Socket.ByteString as Socket-import Network.Socket.Imports-import Network.Socket.ByteString.IO (waitWhen0)-import Network.Socket.Types+import Network.Socket.ByteString.IO (waitWhen0)+import Network.Socket.Imports+import Network.Socket.Types -- ----------------------------------------------------------------------------- -- Sending send- :: Socket -- ^ Connected socket- -> L.ByteString -- ^ Data to send- -> IO Int64 -- ^ Number of bytes sent+ :: Socket+ -- ^ Connected socket+ -> L.ByteString+ -- ^ Data to send+ -> IO Int64+ -- ^ Number of bytes sent send s lbs = case L.toChunks lbs of -- TODO: Consider doing nothing if the string is empty.- [] -> fromIntegral <$> Socket.send s S.empty- (x:_) -> fromIntegral <$> Socket.send s x+ [] -> fromIntegral <$> Socket.send s S.empty+ (x : _) -> fromIntegral <$> Socket.send s x sendAll- :: Socket -- ^ Connected socket- -> L.ByteString -- ^ Data to send+ :: Socket+ -- ^ Connected socket+ -> L.ByteString+ -- ^ Data to send -> IO () sendAll _ "" = return () sendAll s bs0 = loop bs0
Network/Socket/Handle.hs view
@@ -1,8 +1,8 @@ module Network.Socket.Handle where -import qualified GHC.IO.Device (IODeviceType(Stream))+import qualified GHC.IO.Device (IODeviceType (Stream)) import GHC.IO.Handle.FD (fdToHandle')-import System.IO (IOMode(..), Handle, BufferMode(..), hSetBuffering)+import System.IO (BufferMode (..), Handle, IOMode (..), hSetBuffering) import Network.Socket.Types @@ -15,14 +15,13 @@ -- close the 'Socket' after 'socketToHandle', call 'System.IO.hClose' -- on the 'Handle'. ----- Caveat 'Handle' is not recommended for network programming in +-- Caveat 'Handle' is not recommended for network programming in -- Haskell, e.g. merely performing 'hClose' on a TCP socket won't -- cooperate with peer's 'gracefulClose', i.e. proper shutdown -- sequence with appropriate handshakes specified by the protocol.- socketToHandle :: Socket -> IOMode -> IO Handle socketToHandle s mode = invalidateSocket s err $ \oldfd -> do- h <- fdToHandle' oldfd (Just GHC.IO.Device.Stream) True (show s) mode True{-bin-}+ h <- fdToHandle' oldfd (Just GHC.IO.Device.Stream) True (show s) mode True {-bin-} hSetBuffering h NoBuffering return h where
Network/Socket/Imports.hs view
@@ -1,19 +1,19 @@ module Network.Socket.Imports (- module Control.Applicative- , module Control.Monad- , module Data.Bits- , module Data.Int- , module Data.List- , module Data.Maybe- , module Data.Monoid- , module Data.Ord- , module Data.Word- , module Foreign.C.String- , module Foreign.C.Types- , module Foreign.Ptr- , module Foreign.Storable- , module Numeric- ) where+ module Control.Applicative,+ module Control.Monad,+ module Data.Bits,+ module Data.Int,+ module Data.List,+ module Data.Maybe,+ module Data.Monoid,+ module Data.Ord,+ module Data.Word,+ module Foreign.C.String,+ module Foreign.C.Types,+ module Foreign.Ptr,+ module Foreign.Storable,+ module Numeric,+) where import Control.Applicative import Control.Monad
Network/Socket/ReadShow.hs view
@@ -1,16 +1,15 @@-{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternGuards #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE RankNTypes #-}-+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} module Network.Socket.ReadShow where +import Control.Monad (mzero) import Text.Read ((<++)) import qualified Text.Read as P import qualified Text.Read.Lex as P-import Control.Monad (mzero) -- type alias for individual correspondences of a (possibly partial) bijection type Pair a b = (a, b)@@ -18,13 +17,12 @@ -- | helper function for equality on first tuple element {-# INLINE eqFst #-} eqFst :: Eq a => a -> (a, b) -> Bool-eqFst x = \(x',_) -> x' == x+eqFst x = \(x', _) -> x' == x -- | helper function for equality on snd tuple element {-# INLINE eqSnd #-} eqSnd :: Eq b => b -> (a, b) -> Bool-eqSnd y = \(_,y') -> y' == y-+eqSnd y = \(_, y') -> y' == y -- | Unified automorphic involution over @Either a b@ that converts between -- LHS and RHS elements of a list of @Pair a b@ mappings and is the identity@@ -33,9 +31,9 @@ -- If list contains duplicate matches, short-circuits to the first matching @Pair@ lookBetween :: (Eq a, Eq b) => [Pair a b] -> Either a b -> Either a b lookBetween ps = \case- Left x | (_,y):_ <- filter (eqFst x) ps -> Right y- Right y | (x,_):_ <- filter (eqSnd y) ps -> Left x- z -> z+ Left x | (_, y) : _ <- filter (eqFst x) ps -> Right y+ Right y | (x, _) : _ <- filter (eqSnd y) ps -> Left x+ z -> z -- Type alias for partial bijections between two types, consisting of a list -- of individual correspondences that are checked in order and short-circuit@@ -53,13 +51,15 @@ namePrefix :: Int -> String -> (Int -> b -> ShowS) -> b -> ShowS namePrefix i name f x | null name = f i x- | otherwise = showParen (i > app_prec) $ showString name . showChar ' ' . f (app_prec+1) x+ | otherwise =+ showParen (i > app_prec) $ showString name . showChar ' ' . f (app_prec + 1) x {-# INLINE namePrefix #-} -- | Helper function for defining bijective Show instances that represents -- a common use-case where a constructor (or constructor-like pattern) name -- (optionally) precedes an internal value with a separate show function-defShow :: Eq a => String -> (a -> b) -> (Int -> b -> ShowS) -> (Int -> a -> ShowS)+defShow+ :: Eq a => String -> (a -> b) -> (Int -> b -> ShowS) -> (Int -> a -> ShowS) defShow name unwrap shoPrec = \i x -> namePrefix i name shoPrec (unwrap x) {-# INLINE defShow #-} @@ -82,7 +82,7 @@ {-# INLINE defRead #-} -- | Alias for showsPrec that pairs well with `_readInt`-_showInt :: (Show a) => Int -> a -> ShowS+_showInt :: Show a => Int -> a -> ShowS _showInt = showsPrec {-# INLINE _showInt #-} @@ -98,27 +98,29 @@ {-# INLINE showIntInt #-} -- | consume and return two integer-like values from two consecutive lexical tokens-readIntInt :: (Bounded a, Integral a, Bounded b, Integral b) => P.ReadPrec (a, b)+readIntInt+ :: (Bounded a, Integral a, Bounded b, Integral b) => P.ReadPrec (a, b) readIntInt = do- x <- _readInt- y <- _readInt- return (x, y)+ x <- _readInt+ y <- _readInt+ return (x, y) {-# INLINE readIntInt #-} -bijectiveShow :: (Eq a) => Bijection a String -> (Int -> a -> ShowS) -> (Int -> a -> ShowS)+bijectiveShow+ :: Eq a => Bijection a String -> (Int -> a -> ShowS) -> (Int -> a -> ShowS) bijectiveShow bi def = \i x -> case lookBetween bi (Left x) of Right y -> showString y _ -> def i x -bijectiveRead :: (Eq a) => Bijection a String -> P.ReadPrec a -> P.ReadPrec a+bijectiveRead :: Eq a => Bijection a String -> P.ReadPrec a -> P.ReadPrec a bijectiveRead bi def = P.parens $ bijective <++ def where bijective = do- (P.Ident y) <- P.lexP- case lookBetween bi (Right y) of- Left x -> return x- _ -> mzero+ (P.Ident y) <- P.lexP+ case lookBetween bi (Right y) of+ Left x -> return x+ _ -> mzero app_prec :: Int app_prec = 10@@ -129,8 +131,8 @@ safeInt = do i <- signed if (i >= fromIntegral (minBound :: a) && i <= fromIntegral (maxBound :: a))- then return $ fromIntegral i- else mzero+ then return $ fromIntegral i+ else mzero where signed :: P.ReadPrec Integer signed = P.readPrec
+ Network/Socket/STM.hs view
@@ -0,0 +1,24 @@+module Network.Socket.STM where++import Control.Concurrent+import Control.Concurrent.STM+import Network.Socket.Types+import System.Posix.Types++-- | STM action to wait until the socket is ready for reading.+waitReadSocketSTM :: Socket -> IO (STM ())+waitReadSocketSTM s = fst <$> waitAndCancelReadSocketSTM s++-- | STM action to wait until the socket is ready for reading and STM+-- action to cancel the waiting.+waitAndCancelReadSocketSTM :: Socket -> IO (STM (), IO ())+waitAndCancelReadSocketSTM s = withFdSocket s $ threadWaitReadSTM . Fd++-- | STM action to wait until the socket is ready for writing.+waitWriteSocketSTM :: Socket -> IO (STM ())+waitWriteSocketSTM s = fst <$> waitAndCancelWriteSocketSTM s++-- | STM action to wait until the socket is ready for writing and STM+-- action to cancel the waiting.+waitAndCancelWriteSocketSTM :: Socket -> IO (STM (), IO ())+waitAndCancelWriteSocketSTM s = withFdSocket s $ threadWaitWriteSTM . Fd
Network/Socket/SockAddr.hs view
@@ -1,25 +1,26 @@ {-# LANGUAGE CPP #-}+ module Network.Socket.SockAddr (- getPeerName- , getSocketName- , connect- , bind- , accept- , sendBufTo- , recvBufFrom- , sendBufMsg- , recvBufMsg- ) where+ getPeerName,+ getSocketName,+ connect,+ bind,+ accept,+ sendBufTo,+ recvBufFrom,+ sendBufMsg,+ recvBufMsg,+) where -import Control.Exception (try, throwIO, IOException)+import Control.Exception (IOException, throwIO, try) import System.Directory (removeFile) import System.IO.Error (isAlreadyInUseError, isDoesNotExistError) import qualified Network.Socket.Buffer as G-import qualified Network.Socket.Name as G-import qualified Network.Socket.Syscall as G import Network.Socket.Flag import Network.Socket.Imports+import qualified Network.Socket.Name as G+import qualified Network.Socket.Syscall as G #if !defined(mingw32_HOST_OS) import Network.Socket.Posix.Cmsg #else@@ -46,24 +47,24 @@ -- use port. bind :: Socket -> SockAddr -> IO () bind s a = case a of- SockAddrUnix p -> do- -- gracefully handle the fact that UNIX systems don't clean up closed UNIX- -- domain sockets, inspired by https://stackoverflow.com/a/13719866- res <- try (G.bind s a)- case res of- Right () -> return ()- Left e | not (isAlreadyInUseError e) -> throwIO (e :: IOException)- Left e | otherwise -> do- -- socket might be in use, try to connect- res2 <- try (G.connect s a)- case res2 of- Right () -> close s >> throwIO e- Left e2 | not (isDoesNotExistError e2) -> throwIO (e2 :: IOException)- _ -> do- -- socket not actually in use, remove it and retry bind- void (try $ removeFile p :: IO (Either IOError ()))- G.bind s a- _ -> G.bind s a+ SockAddrUnix p -> do+ -- gracefully handle the fact that UNIX systems don't clean up closed UNIX+ -- domain sockets, inspired by https://stackoverflow.com/a/13719866+ res <- try (G.bind s a)+ case res of+ Right () -> return ()+ Left e | not (isAlreadyInUseError e) -> throwIO (e :: IOException)+ Left e | otherwise -> do+ -- socket might be in use, try to connect+ res2 <- try (G.connect s a)+ case res2 of+ Right () -> close s >> throwIO e+ Left e2 | not (isDoesNotExistError e2) -> throwIO (e2 :: IOException)+ _ -> do+ -- socket not actually in use, remove it and retry bind+ void (try $ removeFile p :: IO (Either IOError ()))+ G.bind s a+ _ -> G.bind s a -- | Accept a connection. The socket must be bound to an address and -- listening for connections. The return value is a pair @(conn,@@ -97,22 +98,35 @@ recvBufFrom = G.recvBufFrom -- | Send data to the socket using sendmsg(2).-sendBufMsg :: Socket -- ^ Socket- -> SockAddr -- ^ Destination address- -> [(Ptr Word8,Int)] -- ^ Data to be sent- -> [Cmsg] -- ^ Control messages- -> MsgFlag -- ^ Message flags- -> IO Int -- ^ The length actually sent+sendBufMsg+ :: Socket+ -- ^ Socket+ -> SockAddr+ -- ^ Destination address+ -> [(Ptr Word8, Int)]+ -- ^ Data to be sent+ -> [Cmsg]+ -- ^ Control messages+ -> MsgFlag+ -- ^ Message flags+ -> IO Int+ -- ^ The length actually sent sendBufMsg = G.sendBufMsg -- | Receive data from the socket using recvmsg(2).-recvBufMsg :: Socket -- ^ Socket- -> [(Ptr Word8,Int)] -- ^ A list of a pair of buffer and its size.- -- If the total length is not large enough,- -- 'MSG_TRUNC' is returned- -> Int -- ^ The buffer size for control messages.- -- If the length is not large enough,- -- 'MSG_CTRUNC' is returned- -> MsgFlag -- ^ Message flags- -> IO (SockAddr,Int,[Cmsg],MsgFlag) -- ^ Source address, received data, control messages and message flags+recvBufMsg+ :: Socket+ -- ^ Socket+ -> [(Ptr Word8, Int)]+ -- ^ A list of a pair of buffer and its size.+ -- If the total length is not large enough,+ -- 'MSG_TRUNC' is returned+ -> Int+ -- ^ The buffer size for control messages.+ -- If the length is not large enough,+ -- 'MSG_CTRUNC' is returned+ -> MsgFlag+ -- ^ Message flags+ -> IO (SockAddr, Int, [Cmsg], MsgFlag)+ -- ^ Source address, received data, control messages and message flags recvBufMsg = G.recvBufMsg
Network/Socket/Types.hsc view
@@ -1156,15 +1156,16 @@ -- | Write the given 'SockAddr' to the given memory location. pokeSockAddr :: Ptr a -> SockAddr -> IO () pokeSockAddr p sa@(SockAddrUnix path) = do- when (length path > unixPathMax) $ error+ let pathC = map castCharToCChar path+ len = length pathC+ when (len >= unixPathMax) $ error $ "pokeSockAddr: path is too long in SockAddrUnix " <> show path- <> ", length " <> show (length path) <> ", unixPathMax " <> show unixPathMax+ <> ", length " <> show len <> ", unixPathMax " <> show unixPathMax zeroMemory p $ fromIntegral $ sizeOfSockAddr sa # if defined(HAVE_STRUCT_SOCKADDR_SA_LEN) (#poke struct sockaddr_un, sun_len) p ((#const sizeof(struct sockaddr_un)) :: Word8) # endif (#poke struct sockaddr_un, sun_family) p ((#const AF_UNIX) :: CSaFamily)- let pathC = map castCharToCChar path -- the buffer is already filled with nulls. pokeArray ((#ptr struct sockaddr_un, sun_path) p) pathC pokeSockAddr p (SockAddrInet port addr) = do
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.72 for Haskell network package 3.2.0.0.+# Generated by GNU Autoconf 2.72 for Haskell network package 3.2.2.0. # # Report bugs to <libraries@haskell.org>. #@@ -603,8 +603,8 @@ # Identity of this package. PACKAGE_NAME='Haskell network package' PACKAGE_TARNAME='network'-PACKAGE_VERSION='3.2.0.0'-PACKAGE_STRING='Haskell network package 3.2.0.0'+PACKAGE_VERSION='3.2.2.0'+PACKAGE_STRING='Haskell network package 3.2.2.0' PACKAGE_BUGREPORT='libraries@haskell.org' PACKAGE_URL='' @@ -1258,7 +1258,7 @@ # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF-'configure' configures Haskell network package 3.2.0.0 to adapt to many kinds of systems.+'configure' configures Haskell network package 3.2.2.0 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1324,7 +1324,7 @@ if test -n "$ac_init_help"; then case $ac_init_help in- short | recursive ) echo "Configuration of Haskell network package 3.2.0.0:";;+ short | recursive ) echo "Configuration of Haskell network package 3.2.2.0:";; esac cat <<\_ACEOF @@ -1409,7 +1409,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF-Haskell network package configure 3.2.0.0+Haskell network package configure 3.2.2.0 generated by GNU Autoconf 2.72 Copyright (C) 2023 Free Software Foundation, Inc.@@ -1809,7 +1809,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by Haskell network package $as_me 3.2.0.0, which was+It was created by Haskell network package $as_me 3.2.2.0, which was generated by GNU Autoconf 2.72. Invocation command line was $ $0$ac_configure_args_raw@@ -4699,7 +4699,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by Haskell network package $as_me 3.2.0.0, which was+This file was extended by Haskell network package $as_me 3.2.2.0, which was generated by GNU Autoconf 2.72. Invocation command line was CONFIG_FILES = $CONFIG_FILES@@ -4754,7 +4754,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-Haskell network package config.status 3.2.0.0+Haskell network package config.status 3.2.2.0 configured by $0, generated by GNU Autoconf 2.72, with options \\"\$ac_cs_config\\"
configure.ac view
@@ -1,5 +1,5 @@ AC_INIT([Haskell network package],- [3.2.0.0],+ [3.2.2.0], [libraries@haskell.org], [network])
examples/EchoClient.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ -- Echo client program module Main (main) where @@ -21,7 +22,7 @@ E.bracket (open addr) close client where resolve = do- let hints = defaultHints { addrSocketType = Stream }+ let hints = defaultHints{addrSocketType = Stream} head <$> getAddrInfo (Just hints) (Just host) (Just port) open addr = E.bracketOnError (openSocket addr) close $ \sock -> do connect sock $ addrAddress addr
examples/EchoServer.hs view
@@ -3,7 +3,7 @@ import Control.Concurrent (forkFinally) import qualified Control.Exception as E-import Control.Monad (unless, forever, void)+import Control.Monad (forever, unless, void) import qualified Data.ByteString as S import Network.Socket import Network.Socket.ByteString (recv, sendAll)@@ -14,8 +14,8 @@ talk s = do msg <- recv s 1024 unless (S.null msg) $ do- sendAll s msg- talk s+ sendAll s msg+ talk s -- from the "network-run" package. runTCPServer :: Maybe HostName -> ServiceName -> (Socket -> IO a) -> IO a@@ -24,10 +24,11 @@ E.bracket (open addr) close loop where resolve = do- let hints = defaultHints {- addrFlags = [AI_PASSIVE]- , addrSocketType = Stream- }+ let hints =+ defaultHints+ { addrFlags = [AI_PASSIVE]+ , addrSocketType = Stream+ } head <$> getAddrInfo (Just hints) mhost (Just port) open addr = E.bracketOnError (openSocket addr) close $ \sock -> do setSocketOption sock ReuseAddr 1@@ -35,10 +36,12 @@ bind sock $ addrAddress addr listen sock 1024 return sock- loop sock = forever $ E.bracketOnError (accept sock) (close . fst)- $ \(conn, _peer) -> void $- -- 'forkFinally' alone is unlikely to fail thus leaking @conn@,- -- but 'E.bracketOnError' above will be necessary if some- -- non-atomic setups (e.g. spawning a subprocess to handle- -- @conn@) before proper cleanup of @conn@ is your case- forkFinally (server conn) (const $ gracefulClose conn 5000)+ loop sock = forever $+ E.bracketOnError (accept sock) (close . fst) $+ \(conn, _peer) ->+ void $+ -- 'forkFinally' alone is unlikely to fail thus leaking @conn@,+ -- but 'E.bracketOnError' above will be necessary if some+ -- non-atomic setups (e.g. spawning a subprocess to handle+ -- @conn@) before proper cleanup of @conn@ is your case+ forkFinally (server conn) (const $ gracefulClose conn 5000)
network.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: network-version: 3.2.1.0+version: 3.2.2.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Tamar Christina@@ -115,6 +115,7 @@ Network.Socket.Name Network.Socket.Options Network.Socket.ReadShow+ Network.Socket.STM Network.Socket.Shutdown Network.Socket.SockAddr Network.Socket.Syscall@@ -132,7 +133,8 @@ base >=4.9 && <5, bytestring >=0.10, deepseq,- directory+ directory,+ stm if !os(windows) other-modules:
tests/BadFileDescriptor.hs view
@@ -7,7 +7,7 @@ module Main where import Control.Concurrent (forkIO)-import Control.Monad (void, forever)+import Control.Monad (forever, void) import Network.Socket hiding (recv) import Network.Socket.ByteString (recv, sendAll) @@ -32,11 +32,12 @@ serverSocket :: HostName -> ServiceName -> IO Socket serverSocket host port = do- let hints = defaultHints {- addrFlags = [AI_PASSIVE]- , addrSocketType = Stream- }- addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)+ let hints =+ defaultHints+ { addrFlags = [AI_PASSIVE]+ , addrSocketType = Stream+ }+ addr : _ <- getAddrInfo (Just hints) (Just host) (Just port) sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) bind sock (addrAddress addr) listen sock 1@@ -44,8 +45,8 @@ clientSocket :: HostName -> ServiceName -> IO Socket clientSocket host port = do- let hints = defaultHints { addrSocketType = Stream }- addr:_ <- getAddrInfo (Just hints) (Just host) (Just port)+ let hints = defaultHints{addrSocketType = Stream}+ addr : _ <- getAddrInfo (Just hints) (Just host) (Just port) sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr) connect sock (addrAddress addr) return sock
tests/Network/Socket/ByteString/LazySpec.hs view
@@ -5,11 +5,11 @@ import Prelude hiding (getContents) +import Control.Monad import qualified Data.ByteString.Lazy as L import Network.Socket import Network.Socket.ByteString.Lazy import Network.Test.Common-import Control.Monad import Test.Hspec
tests/Network/Socket/ByteStringSpec.hs view
@@ -3,11 +3,11 @@ module Network.Socket.ByteStringSpec (main, spec) where import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)-import Data.Bits-import Data.Maybe import Control.Monad+import Data.Bits import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C+import Data.Maybe import Network.Socket import Network.Socket.ByteString import Network.Test.Common@@ -243,20 +243,23 @@ serverReady <- newEmptyMVar let server sock = do- whenSupported RecvIPv4TTL $ setSocketOption sock RecvIPv4TTL 1+ whenSupported RecvIPv4TTL $ setSocketOption sock RecvIPv4TTL 1 whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1- whenSupported RecvIPv4TOS $ setSocketOption sock RecvIPv4TOS 1+ whenSupported RecvIPv4TOS $ setSocketOption sock RecvIPv4TOS 1 putMVar serverReady () (_, _, cmsgs, _) <- recvMsg sock 1024 128 mempty whenSupported RecvIPv4PktInfo $- ((lookupCmsg CmsgIdIPv4PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv4PktInfo) `shouldNotBe` Nothing+ ((lookupCmsg CmsgIdIPv4PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv4PktInfo)+ `shouldNotBe` Nothing when (not isAppVeyor) $ do- whenSupported RecvIPv4TTL $- ((lookupCmsg CmsgIdIPv4TTL cmsgs >>= decodeCmsg) :: Maybe IPv4TTL) `shouldNotBe` Nothing- whenSupported RecvIPv4TOS $- ((lookupCmsg CmsgIdIPv4TOS cmsgs >>= decodeCmsg) :: Maybe IPv4TOS) `shouldNotBe` Nothing+ whenSupported RecvIPv4TTL $+ ((lookupCmsg CmsgIdIPv4TTL cmsgs >>= decodeCmsg) :: Maybe IPv4TTL)+ `shouldNotBe` Nothing+ whenSupported RecvIPv4TOS $+ ((lookupCmsg CmsgIdIPv4TOS cmsgs >>= decodeCmsg) :: Maybe IPv4TOS)+ `shouldNotBe` Nothing client sock addr = takeMVar serverReady >> sendTo sock seg addr seg = C.pack "This is a test message"@@ -270,18 +273,21 @@ let server sock = do whenSupported RecvIPv6HopLimit $ setSocketOption sock RecvIPv6HopLimit 1- whenSupported RecvIPv6TClass $ setSocketOption sock RecvIPv6TClass 1- whenSupported RecvIPv6PktInfo $ setSocketOption sock RecvIPv6PktInfo 1+ whenSupported RecvIPv6TClass $ setSocketOption sock RecvIPv6TClass 1+ whenSupported RecvIPv6PktInfo $ setSocketOption sock RecvIPv6PktInfo 1 putMVar serverReady () (_, _, cmsgs, _) <- recvMsg sock 1024 128 mempty whenSupported RecvIPv6HopLimit $- ((lookupCmsg CmsgIdIPv6HopLimit cmsgs >>= decodeCmsg) :: Maybe IPv6HopLimit) `shouldNotBe` Nothing+ ((lookupCmsg CmsgIdIPv6HopLimit cmsgs >>= decodeCmsg) :: Maybe IPv6HopLimit)+ `shouldNotBe` Nothing whenSupported RecvIPv6TClass $- ((lookupCmsg CmsgIdIPv6TClass cmsgs >>= decodeCmsg) :: Maybe IPv6TClass) `shouldNotBe` Nothing+ ((lookupCmsg CmsgIdIPv6TClass cmsgs >>= decodeCmsg) :: Maybe IPv6TClass)+ `shouldNotBe` Nothing whenSupported RecvIPv6PktInfo $- ((lookupCmsg CmsgIdIPv6PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv6PktInfo) `shouldNotBe` Nothing+ ((lookupCmsg CmsgIdIPv6PktInfo cmsgs >>= decodeCmsg) :: Maybe IPv6PktInfo)+ `shouldNotBe` Nothing client sock addr = takeMVar serverReady >> sendTo sock seg addr seg = C.pack "This is a test message"@@ -294,8 +300,8 @@ serverReady <- newEmptyMVar let server sock = do- whenSupported RecvIPv4TTL $ setSocketOption sock RecvIPv4TTL 1- whenSupported RecvIPv4TOS $ setSocketOption sock RecvIPv4TOS 1+ whenSupported RecvIPv4TTL $ setSocketOption sock RecvIPv4TTL 1+ whenSupported RecvIPv4TOS $ setSocketOption sock RecvIPv4TOS 1 whenSupported RecvIPv4PktInfo $ setSocketOption sock RecvIPv4PktInfo 1 putMVar serverReady ()