network 3.0.0.1 → 3.0.1.0
raw patch · 16 files changed
+625/−438 lines, 16 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Network.Socket: getSocketType :: Socket -> IO SocketType
Files
- CHANGELOG.md +12/−0
- Network/Socket.hs +1/−0
- Network/Socket/Buffer.hs +0/−4
- Network/Socket/ByteString.hs +0/−6
- Network/Socket/ByteString/IO.hsc +0/−16
- Network/Socket/ByteString/Lazy.hs +4/−3
- Network/Socket/Options.hsc +8/−0
- Network/Socket/Types.hsc +18/−6
- configure.ac +1/−1
- network.cabal +6/−3
- tests/Network/Socket/ByteString/LazySpec.hs +85/−0
- tests/Network/Socket/ByteStringSpec.hs +191/−0
- tests/Network/SocketSpec.hs +110/−0
- tests/Network/Test/Common.hs +189/−0
- tests/RegressionSpec.hs +0/−29
- tests/SimpleSpec.hs +0/−370
CHANGELOG.md view
@@ -1,3 +1,15 @@+## Version 3.0.1.0++* Added `getSocketType :: Socket -> IO SocketType`.+ [#372](https://github.com/haskell/network/pull/372)+* Correcting manual and brushing up test cases+ [#375](https://github.com/haskell/network/pull/375)+* Fixed longstanded bug in `getContents` on mac+ [#375](https://github.com/haskell/network/pull/375)+* Fixing regression: set correct sockaddr length for abstract addresses+ for Linux.+ [#374](https://github.com/haskell/network/pull/374)+ ## Version 3.0.0.1 * Fixed a bug in `connect` where exceptions were not thrown
Network/Socket.hs view
@@ -141,6 +141,7 @@ -- ** Types of Socket , SocketType(..) , isSupportedSocketType+ , getSocketType -- ** Family , Family(..) , isSupportedFamily
Network/Socket/Buffer.hs view
@@ -53,8 +53,6 @@ -- | Send data to the socket. The socket must be connected to a remote -- socket. Returns the number of bytes sent. Applications are -- responsible for ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour. sendBuf :: Socket -- Bound/Connected Socket -> Ptr Word8 -- Pointer to the data to send -> Int -- Length of the buffer@@ -115,8 +113,6 @@ -- The return value is the length of received data. Zero means -- EOF. Historical note: Version 2.8.x.y or earlier, -- an EOF error was thrown. This was changed in version 3.0.------ Receiving data from closed socket may lead to undefined behaviour. recvBuf :: Socket -> Ptr Word8 -> Int -> IO Int recvBuf s ptr nbytes | nbytes <= 0 = ioError (mkInvalidRecvArgError "Network.Socket.recvBuf")
Network/Socket/ByteString.hs view
@@ -68,8 +68,6 @@ -- explicitly, so the socket need not be in a connected state. -- Returns the number of bytes sent. Applications are responsible for -- ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour. sendTo :: Socket -> ByteString -> SockAddr -> IO Int sendTo = G.sendTo @@ -79,8 +77,6 @@ -- data has been sent or an error occurs. On error, an exception is -- raised, and there is no way to determine how much data, if any, was -- successfully sent.------ Sending data to closed socket may lead to undefined behaviour. sendAllTo :: Socket -> ByteString -> SockAddr -> IO () sendAllTo = G.sendAllTo @@ -88,8 +84,6 @@ -- connected state. Returns @(bytes, address)@ where @bytes@ is a -- 'ByteString' representing the data received and @address@ is a -- 'SockAddr' representing the address of the sending socket.------ Receiving data from closed socket may lead to undefined behaviour. recvFrom :: Socket -> Int -> IO (ByteString, SockAddr) recvFrom = G.recvFrom
Network/Socket/ByteString/IO.hsc view
@@ -73,8 +73,6 @@ -- | Send data to the socket. The socket must be connected to a -- remote socket. Returns the number of bytes sent. Applications are -- responsible for ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour. send :: Socket -- ^ Connected socket -> ByteString -- ^ Data to send -> IO Int -- ^ Number of bytes sent@@ -92,8 +90,6 @@ -- until either all data has been sent or an error occurs. On error, -- an exception is raised, and there is no way to determine how much -- data, if any, was successfully sent.------ Sending data to closed socket may lead to undefined behaviour. sendAll :: Socket -- ^ Connected socket -> ByteString -- ^ Data to send -> IO ()@@ -107,8 +103,6 @@ -- explicitly, so the socket need not be in a connected state. -- Returns the number of bytes sent. Applications are responsible for -- ensuring that all data has been sent.------ Sending data to closed socket may lead to undefined behaviour. sendTo :: SocketAddress sa => Socket -- ^ Socket -> ByteString -- ^ Data to send@@ -123,8 +117,6 @@ -- data has been sent or an error occurs. On error, an exception is -- raised, and there is no way to determine how much data, if any, was -- successfully sent.------ Sending data to closed socket may lead to undefined behaviour. sendAllTo :: SocketAddress sa => Socket -- ^ Socket -> ByteString -- ^ Data to send@@ -142,8 +134,6 @@ -- sent or an error occurs. On error, an exception is raised, and -- there is no way to determine how much data, if any, was -- successfully sent.------ Sending data to closed socket may lead to undefined behaviour. sendMany :: Socket -- ^ Connected socket -> [ByteString] -- ^ Data to send -> IO ()@@ -170,8 +160,6 @@ -- continues to send data until either all data has been sent or an -- error occurs. On error, an exception is raised, and there is no -- way to determine how much data, if any, was successfully sent.------ Sending data to closed socket may lead to undefined behaviour. sendManyTo :: Socket -- ^ Socket -> [ByteString] -- ^ Data to send -> SockAddr -- ^ Recipient address@@ -211,8 +199,6 @@ -- -- For TCP sockets, a zero length return value means the peer has -- closed its half side of the connection.------ Receiving data from closed socket may lead to undefined behaviour. recv :: Socket -- ^ Connected socket -> Int -- ^ Maximum number of bytes to receive -> IO ByteString -- ^ Data received@@ -226,8 +212,6 @@ -- 'SockAddr' representing the address of the sending socket. -- -- If the first return value is zero, it means EOF.------ Receiving data from closed socket may lead to undefined behaviour. recvFrom :: SocketAddress sa => Socket -- ^ Socket -> Int -- ^ Maximum number of bytes to receive
Network/Socket/ByteString/Lazy.hs view
@@ -33,6 +33,7 @@ import Network.Socket (ShutdownCmd (..), shutdown) import Prelude hiding (getContents) import System.IO.Unsafe (unsafeInterleaveIO)+import System.IO.Error (catchIOError) #if defined(mingw32_HOST_OS) import Network.Socket.ByteString.Lazy.Windows (send, sendAll)@@ -64,7 +65,9 @@ loop = unsafeInterleaveIO $ do sbs <- N.recv s defaultChunkSize if S.null sbs- then shutdown s ShutdownReceive >> return Empty+ then do+ shutdown s ShutdownReceive `catchIOError` const (return ())+ return Empty else Chunk sbs <$> loop -- | Receive data from the socket. The socket must be in a connected@@ -74,8 +77,6 @@ -- until a message arrives. -- -- If there is no more data to be received, returns an empty 'ByteString'.------ Receiving data from closed socket may lead to undefined behaviour. recv :: Socket -- ^ Connected socket -> Int64 -- ^ Maximum number of bytes to receive
Network/Socket/Options.hsc view
@@ -8,6 +8,7 @@ module Network.Socket.Options ( SocketOption(..) , isSupportedSocketOption+ , getSocketType , getSocketOption , setSocketOption , c_getsockopt@@ -58,6 +59,13 @@ -- | Does the 'SocketOption' exist on this system? isSupportedSocketOption :: SocketOption -> Bool isSupportedSocketOption = isJust . packSocketOption++-- | Get the 'SocketType' of an active socket.+--+-- Since: 3.0.1.0+getSocketType :: Socket -> IO SocketType+getSocketType s = (fromMaybe NoSocketType . unpackSocketType . fromIntegral)+ <$> getSocketOption s Type -- | For a socket option, return Just (level, value) where level is the -- corresponding C option level constant (e.g. SOL_SOCKET) and value is
Network/Socket/Types.hsc view
@@ -136,9 +136,6 @@ -- | Close the socket. This function does not throw exceptions even if -- the underlying system call returns errors. ----- Sending data to or receiving data from closed socket--- may lead to undefined behaviour.--- -- If multiple threads use the same socket and one uses 'fdSocket' and -- the other use 'close', unexpected behavior may happen. -- For more information, please refer to the documentation of 'fdSocket'.@@ -156,9 +153,6 @@ -- | Close the socket. This function throws exceptions if -- the underlying system call returns errors.------ Sending data to or receiving data from closed socket--- may lead to undefined behaviour. close' :: Socket -> IO () close' s = invalidateSocket s (\_ -> return ()) $ \oldfd -> do -- closeFdWith avoids the deadlock of IO manager.@@ -941,7 +935,25 @@ -- in that the value of the argument /is/ used. sizeOfSockAddr :: SockAddr -> Int #if defined(DOMAIN_SOCKET_SUPPORT)+# ifdef linux_HOST_OS+-- http://man7.org/linux/man-pages/man7/unix.7.html says:+-- "an abstract socket address is distinguished (from a+-- pathname socket) by the fact that sun_path[0] is a null byte+-- ('\0'). The socket's address in this namespace is given by the+-- additional bytes in sun_path that are covered by the specified+-- length of the address structure. (Null bytes in the name have no+-- special significance.) The name has no connection with filesystem+-- pathnames. When the address of an abstract socket is returned,+-- the returned addrlen is greater than sizeof(sa_family_t) (i.e.,+-- greater than 2), and the name of the socket is contained in the+-- first (addrlen - sizeof(sa_family_t)) bytes of sun_path."+sizeOfSockAddr (SockAddrUnix path) =+ case path of+ '\0':_ -> (#const sizeof(sa_family_t)) + length path+ _ -> #const sizeof(struct sockaddr_un)+# else sizeOfSockAddr SockAddrUnix{} = #const sizeof(struct sockaddr_un)+# endif #else sizeOfSockAddr SockAddrUnix{} = error "sizeOfSockAddr: not supported" #endif
configure.ac view
@@ -1,5 +1,5 @@ AC_INIT([Haskell network package],- [3.0.0.1],+ [3.0.1.0], [libraries@haskell.org], [network])
network.cabal view
@@ -1,6 +1,6 @@ cabal-version: 1.18 name: network-version: 3.0.0.1+version: 3.0.1.0 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto, Evan Borden@@ -115,8 +115,11 @@ default-language: Haskell2010 hs-source-dirs: tests main-is: Spec.hs- other-modules: RegressionSpec- SimpleSpec+ other-modules:+ Network.Test.Common+ Network.SocketSpec+ Network.Socket.ByteStringSpec+ Network.Socket.ByteString.LazySpec type: exitcode-stdio-1.0 ghc-options: -Wall -threaded -- NB: make sure to versions of hspec and hspec-discover
+ tests/Network/Socket/ByteString/LazySpec.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Socket.ByteString.LazySpec (main, spec) where++import Prelude hiding (getContents)++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++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "send" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` lazyTestMsg+ client sock = send sock lazyTestMsg+ tcpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock = do+ close sock+ send sock lazyTestMsg `shouldThrow` anyException+ tcpTest client server++ describe "sendAll" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` lazyTestMsg+ client sock = sendAll sock lazyTestMsg+ tcpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock = do+ close sock+ sendAll sock lazyTestMsg `shouldThrow` anyException+ tcpTest client server++ describe "getContents" $ do+ it "works well" $ do+ let server sock = getContents sock `shouldReturn` lazyTestMsg+ client sock = do+ void $ send sock lazyTestMsg+ shutdown sock ShutdownSend+ tcpTest client server++ it "returns empty string at EOF" $ do+ let client s = getContents s `shouldReturn` L.empty+ server s = shutdown s ShutdownSend+ tcpTest client server++ describe "recv" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` lazyTestMsg+ client sock = send sock lazyTestMsg+ tcpTest client server++ it "throws when closed" $ do+ let server sock = do+ close sock+ recv sock 1024 `shouldThrow` anyException+ client sock = send sock lazyTestMsg+ tcpTest client server++ it "can treat overflow" $ do+ let server sock = do+ seg1 <- recv sock (L.length lazyTestMsg - 3)+ seg2 <- recv sock 1024+ let msg = L.append seg1 seg2+ msg `shouldBe` lazyTestMsg+ client sock = send sock lazyTestMsg+ tcpTest client server++ it "returns empty string at EOF" $ do+ let client s = recv s 4096 `shouldReturn` L.empty+ server s = shutdown s ShutdownSend+ tcpTest client server
+ tests/Network/Socket/ByteStringSpec.hs view
@@ -0,0 +1,191 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Socket.ByteStringSpec (main, spec) where++import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as C+import Network.Socket+import Network.Socket.ByteString+import Network.Test.Common++import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "send" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` testMsg+ client sock = send sock testMsg+ tcpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock = do+ close sock+ send sock testMsg `shouldThrow` anyException+ tcpTest client server++ it "checks -1 correctly on Windows" $ do+ sock <- socket AF_INET Stream defaultProtocol+ send sock "hello world" `shouldThrow` anyException++ describe "sendAll" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` testMsg+ client sock = sendAll sock testMsg+ tcpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock = do+ close sock+ sendAll sock testMsg `shouldThrow` anyException+ tcpTest client server++ describe "sendTo" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` testMsg+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ sendTo sock testMsg $ addrAddress addr+ udpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ close sock+ sendTo sock testMsg (addrAddress addr) `shouldThrow` anyException+ udpTest client server++ describe "sendAllTo" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` testMsg+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ sendAllTo sock testMsg $ addrAddress addr+ udpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ close sock+ sendAllTo sock testMsg (addrAddress addr) `shouldThrow` anyException+ udpTest client server++ describe "sendMany" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2+ client sock = sendMany sock [seg1, seg2]++ seg1 = C.pack "This is a "+ seg2 = C.pack "test message."+ tcpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock = do+ close sock+ sendMany sock [seg1, seg2] `shouldThrow` anyException++ seg1 = C.pack "This is a "+ seg2 = C.pack "test message."+ tcpTest client server++ describe "sendManyTo" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` S.append seg1 seg2+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ sendManyTo sock [seg1, seg2] $ addrAddress addr++ seg1 = C.pack "This is a "+ seg2 = C.pack "test message."+ udpTest client server++ it "throws when closed" $ do+ let server _ = return ()+ client sock serverPort = do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ close sock+ sendManyTo sock [seg1, seg2] (addrAddress addr) `shouldThrow` anyException++ seg1 = C.pack "This is a "+ seg2 = C.pack "test message."+ udpTest client server++ describe "recv" $ do+ it "works well" $ do+ let server sock = recv sock 1024 `shouldReturn` testMsg+ client sock = send sock testMsg+ tcpTest client server++ it "throws when closed" $ do+ let server sock = do+ close sock+ recv sock 1024 `shouldThrow` anyException+ client sock = send sock testMsg+ tcpTest client server++ it "can treat overflow" $ do+ let server sock = do+ seg1 <- recv sock (S.length testMsg - 3)+ seg2 <- recv sock 1024+ let msg = S.append seg1 seg2+ msg `shouldBe` testMsg+ client sock = send sock testMsg+ tcpTest client server++ it "returns empty string at EOF" $ do+ let client s = recv s 4096 `shouldReturn` S.empty+ server s = shutdown s ShutdownSend+ tcpTest client server++ it "checks -1 correctly on Windows" $ do+ sock <- socket AF_INET Stream defaultProtocol+ recv sock 1024 `shouldThrow` anyException++ describe "recvFrom" $ do+ it "works well" $ do+ let server sock = do+ (msg, _) <- recvFrom sock 1024+ testMsg `shouldBe` msg+ client sock = do+ addr <- getPeerName sock+ sendTo sock testMsg addr+ tcpTest client server++ it "throws when closed" $ do+ let server sock = do+ close sock+ recvFrom sock 1024 `shouldThrow` anyException+ client sock = do+ addr <- getPeerName sock+ sendTo sock testMsg addr+ tcpTest client server++ it "can treat overflow" $ do+ let server sock = do+ (seg1, _) <- recvFrom sock (S.length testMsg - 3)+ (seg2, _) <- recvFrom sock 1024+ let msg = S.append seg1 seg2+ testMsg `shouldBe` msg+ client sock = send sock testMsg+ tcpTest client server++ it "returns empty string at EOF" $ do+ let server sock = do+ (seg1, _) <- recvFrom sock (S.length testMsg - 3)+ seg1 `shouldBe` S.empty+ client sock = shutdown sock ShutdownSend+ tcpTest client server
+ tests/Network/SocketSpec.hs view
@@ -0,0 +1,110 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.SocketSpec (main, spec) where++import Control.Concurrent.MVar (readMVar)+import Control.Monad+import Network.Socket+import Network.Socket.ByteString+import Network.Test.Common++import Test.Hspec++main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "connect" $ do+ let+ hints = defaultHints { addrSocketType = Stream }+ connect' serverPort = do+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ connect sock (addrAddress addr)+ return sock++ it "fails to connect and throws an IOException" $ do+ connect' (8080 :: Int) `shouldThrow` anyIOException++ it "successfully connects to a socket with no exception" $ do+ tcpTestUsingClient return return $ readMVar >=> connect'++ describe "UserTimeout" $ do+ it "can be set" $ do+ when (isSupportedSocketOption UserTimeout) $ do+ sock <- socket AF_INET Stream defaultProtocol+ setSocketOption sock UserTimeout 1000+ getSocketOption sock UserTimeout `shouldReturn` 1000+ setSocketOption sock UserTimeout 2000+ getSocketOption sock UserTimeout `shouldReturn` 2000+ close sock++ -- On various BSD systems the peer credentials are exchanged during+ -- connect(), and this does not happen with `socketpair()`. Therefore,+ -- we must actually set up a listener and connect, rather than use a+ -- socketpair().+ --+ describe "getPeerCredential" $ do+ it "can return something" $ do+ when isUnixDomainSocketAvailable $ do+ -- It would be useful to check that we did not get garbage+ -- back, but rather the actual uid of the test program. For+ -- that we'd need System.Posix.User, but that is not available+ -- under Windows. For now, accept the risk that we did not get+ -- the right answer.+ --+ let client sock = do+ (_, uid, _) <- getPeerCredential sock+ uid `shouldNotBe` Nothing+ server (sock, _) = do+ (_, uid, _) <- getPeerCredential sock+ uid `shouldNotBe` Nothing+ unixTest client server+ {- The below test fails on many *BSD systems, because the getsockopt()+ call that underlies getpeereid() does not have the same meaning for+ all address families, but the C-library was not checking that the+ provided sock is an AF_UNIX socket. This will fixed some day, but+ we should not fail on those systems in the mean-time. The upstream+ C-library fix is to call getsockname() and check the address family+ before calling `getpeereid()`. We could duplicate that in our own+ code, and then this test would work on those platforms that have+ `getpeereid()` and not the SO_PEERCRED socket option.++ it "return nothing for non-UNIX-domain socket" $ do+ when isUnixDomainSocketAvailable $ do+ s <- socket AF_INET Stream defaultProtocol+ cred1 <- getPeerCredential s+ cred1 `shouldBe` (Nothing,Nothing,Nothing)+ -}++ describe "getAddrInfo" $ do+ it "works for IPv4 address" $ do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }+ AddrInfo{addrAddress = (SockAddrInet _ hostAddr)}:_ <-+ getAddrInfo (Just hints) (Just "127.128.129.130") Nothing+ hostAddressToTuple hostAddr `shouldBe` (0x7f, 0x80, 0x81, 0x82)++#if defined(IPV6_SOCKET_SUPPORT)+ it "works for IPv6 address" $ do+ let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }+ host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"+ AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)}:_ <-+ getAddrInfo (Just hints) (Just host) Nothing+ hostAddress6ToTuple hostAddr+ `shouldBe` (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)+#endif++ it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do+ let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }+ void $ getAddrInfo (Just hints) (Just "localhost") Nothing++ describe "unix sockets" $ do+ it "basic unix sockets end-to-end" $ do+ when isUnixDomainSocketAvailable $ do+ let client sock = send sock testMsg+ server (sock, addr) = do+ recv sock 1024 `shouldReturn` testMsg+ addr `shouldBe` (SockAddrUnix "")+ unixTest client server
+ tests/Network/Test/Common.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Network.Test.Common+ ( serverAddr+ , testMsg+ , lazyTestMsg+ , tcpTest+ , unixTest+ , udpTest+ , tcpTestUsingClient+ ) where++import Control.Concurrent (ThreadId, forkIO, myThreadId)+import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)+import qualified Control.Exception as E+import Control.Monad+import Data.ByteString (ByteString)+import Network.Socket+import System.Directory+import qualified Data.ByteString.Lazy as L+import System.Timeout (timeout)++import Test.Hspec++serverAddr :: String+serverAddr = "127.0.0.1"++testMsg :: ByteString+testMsg = "This is a test message."++lazyTestMsg :: L.ByteString+lazyTestMsg = L.fromStrict "This is a test message."++unixAddr :: String+unixAddr = "/tmp/network-test"++-- | Establish a connection between client and server and then run+-- 'clientAct' and 'serverAct', in different threads. Both actions+-- get passed a connected 'Socket', used for communicating between+-- client and server. 'unixTest' makes sure that the 'Socket' is+-- closed after the actions have run.+unixTest :: (Socket -> IO a) -> ((Socket, SockAddr) -> IO b) -> IO ()+unixTest clientAct serverAct =+ test clientSetup clientAct serverSetup server+ where+ clientSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ connect sock (SockAddrUnix unixAddr)+ return sock++ serverSetup = do+ sock <- socket AF_UNIX Stream defaultProtocol+ unlink unixAddr -- just in case+ bind sock (SockAddrUnix unixAddr)+ listen sock 1+ return sock++ server sock = E.bracket (accept sock) (killClientSock . fst) serverAct++ unlink file = do+ exist <- doesFileExist file+ when exist $ removeFile file++ killClientSock sock = do+ shutdown sock ShutdownBoth+ close sock+ unlink unixAddr++-- | Establish a connection between client and server and then run+-- 'clientAct' and 'serverAct', in different threads. Both actions+-- get passed a connected 'Socket', used for communicating between+-- client and server. 'tcpTest' makes sure that the 'Socket' is+-- closed after the actions have run.+tcpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()+tcpTest clientAct serverAct =+ tcpTestUsingClient serverAct clientAct clientSetup+ where+ clientSetup portVar = do+ let hints = defaultHints { addrSocketType = Stream }+ serverPort <- readMVar portVar+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+#if !defined(mingw32_HOST_OS)+ fd <- fdSocket sock+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` False+#endif+ connect sock $ addrAddress addr+ return sock++tcpTestUsingClient+ :: (Socket -> IO a) -> (Socket -> IO b) -> (MVar PortNumber -> IO Socket) -> IO ()+tcpTestUsingClient serverAct clientAct clientSetup = do+ portVar <- newEmptyMVar+ test (clientSetup portVar) clientAct (serverSetup portVar) server+ where+ serverSetup portVar = do+ let hints = defaultHints {+ addrFlags = [AI_PASSIVE]+ , addrSocketType = Stream+ }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ fd <- fdSocket sock+#if !defined(mingw32_HOST_OS)+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` False+#endif+ setSocketOption sock ReuseAddr 1+ setCloseOnExecIfNeeded fd+#if !defined(mingw32_HOST_OS)+ getCloseOnExec fd `shouldReturn` True+#endif+ bind sock $ addrAddress addr+ listen sock 1+ serverPort <- socketPort sock+ putMVar portVar serverPort+ return sock++ server sock = do+ (clientSock, _) <- accept sock+#if !defined(mingw32_HOST_OS)+ fd <- fdSocket clientSock+ getNonBlock fd `shouldReturn` True+ getCloseOnExec fd `shouldReturn` True+#endif+ _ <- serverAct clientSock+ close clientSock++-- | Create an unconnected 'Socket' for sending UDP and receiving+-- datagrams and then run 'clientAct' and 'serverAct'.+udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()+udpTest clientAct serverAct = do+ portVar <- newEmptyMVar+ test clientSetup (client portVar) (serverSetup portVar) serverAct+ where+ clientSetup = socket AF_INET Datagram defaultProtocol++ client portVar sock = do+ serverPort <- readMVar portVar+ clientAct sock serverPort++ serverSetup portVar = do+ let hints = defaultHints {+ addrFlags = [AI_PASSIVE]+ , addrSocketType = Datagram+ }+ addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)+ setSocketOption sock ReuseAddr 1+ bind sock $ addrAddress addr+ serverPort <- socketPort sock+ putMVar portVar serverPort+ return sock++-- | Run a client/server pair and synchronize them so that the server+-- is started before the client and the specified server action is+-- finished before the client closes the 'Socket'.+test :: IO Socket -> (Socket -> IO b) -> IO Socket -> (Socket -> IO c) -> IO ()+test clientSetup clientAct serverSetup serverAct = do+ tid <- myThreadId+ barrier <- newEmptyMVar+ _ <- forkIO $ server barrier+ client tid barrier+ where+ server barrier =+ E.bracket serverSetup close $ \sock -> do+ serverReady+ Just _ <- timeout 1000000 $ serverAct sock+ putMVar barrier ()+ where+ -- | Signal to the client that it can proceed.+ serverReady = putMVar barrier ()++ client tid barrier = do+ takeMVar barrier+ -- Transfer exceptions to the main thread.+ bracketWithReraise tid clientSetup close $ \res -> do+ Just _ <- timeout 1000000 $ clientAct res+ takeMVar barrier++-- | Like 'bracket' but catches and reraises the exception in another+-- thread, specified by the first argument.+bracketWithReraise :: ThreadId -> IO a -> (a -> IO b) -> (a -> IO ()) -> IO ()+bracketWithReraise tid setup teardown thing =+ E.bracket setup teardown thing+ `E.catch` \ (e :: E.SomeException) -> E.throwTo tid e
− tests/RegressionSpec.hs
@@ -1,29 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Tests for things that didn't work in the past.-module RegressionSpec (main, spec) where--import Control.Monad-import Network.Socket-import Network.Socket.ByteString--import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "getAddrInfo" $ do- it "does not cause segfault on macOS 10.8.2 due to AI_NUMERICSERV" $ do- let hints = defaultHints { addrFlags = [AI_NUMERICSERV] }- void $ getAddrInfo (Just hints) (Just "localhost") Nothing-- describe "Network.Socket.ByteString.recv" $ do- it "checks -1 correctly on Windows" $ do- sock <- socket AF_INET Stream defaultProtocol- recv sock 1024 `shouldThrow` anyException-- describe "Network.Socket.ByteString.send" $ do- it "checks -1 correctly on Windows" $ do- sock <- socket AF_INET Stream defaultProtocol- send sock "hello world" `shouldThrow` anyException
− tests/SimpleSpec.hs
@@ -1,370 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}--module SimpleSpec (main, spec) where--import Control.Concurrent (ThreadId, forkIO, myThreadId)-import Control.Concurrent.MVar (MVar, newEmptyMVar, putMVar, takeMVar, readMVar)-import qualified Control.Exception as E-import Control.Monad-import Data.ByteString (ByteString)-import qualified Data.ByteString as S-import qualified Data.ByteString.Char8 as C-import qualified Data.ByteString.Lazy as L-import Network.Socket-import Network.Socket.ByteString-import qualified Network.Socket.ByteString.Lazy as Lazy-import System.Directory-import System.Timeout (timeout)--import Test.Hspec--main :: IO ()-main = hspec spec--spec :: Spec-spec = do- describe "send" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock = send sock testMsg- tcpTest client server-- describe "sendAll" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock = sendAll sock testMsg- tcpTest client server-- describe "sendTo" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock serverPort = do- let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)- sendTo sock testMsg $ addrAddress addr- udpTest client server-- describe "sendAllTo" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock serverPort = do- let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)- sendAllTo sock testMsg $ addrAddress addr- udpTest client server-- describe "sendMany" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` (S.append seg1 seg2)- client sock = sendMany sock [seg1, seg2]-- seg1 = C.pack "This is a "- seg2 = C.pack "test message."- tcpTest client server-- describe "sendManyTo" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` (S.append seg1 seg2)- client sock serverPort = do- let hints = defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)- sendManyTo sock [seg1, seg2] $ addrAddress addr-- seg1 = C.pack "This is a "- seg2 = C.pack "test message."- udpTest client server-- describe "recv" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock = send sock testMsg- tcpTest client server-- it "can treat overflow" $ do- let server sock = do seg1 <- recv sock (S.length testMsg - 3)- seg2 <- recv sock 1024- let msg = S.append seg1 seg2- msg `shouldBe` testMsg- client sock = send sock testMsg- tcpTest client server-- it "returns empty string at EOF" $ do- let client s = recv s 4096 `shouldReturn` S.empty- server s = shutdown s ShutdownSend- tcpTest client server-- describe "recvFrom" $ do- it "works well" $ do- let server sock = do (msg, _) <- recvFrom sock 1024- testMsg `shouldBe` msg- client sock = do- addr <- getPeerName sock- sendTo sock testMsg addr- tcpTest client server- it "can treat overflow" $ do- let server sock = do (seg1, _) <- recvFrom sock (S.length testMsg - 3)- (seg2, _) <- recvFrom sock 1024- let msg = S.append seg1 seg2- testMsg `shouldBe` msg-- client sock = send sock testMsg- tcpTest client server- describe "connect" $ do- let- hints = defaultHints { addrSocketType = Stream }- connect' serverPort = do- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)- connect sock (addrAddress addr)- return sock- it "fails to connect and throws an IOException" $ do- connect' (8080 :: Int) `shouldThrow` anyIOException- it "successfully connects to a socket with no exception" $ do- tcpTestUsingClient return return $ readMVar >=> connect'-- describe "UserTimeout" $ do- it "can be set" $ do- when (isSupportedSocketOption UserTimeout) $ do- sock <- socket AF_INET Stream defaultProtocol- setSocketOption sock UserTimeout 1000- getSocketOption sock UserTimeout `shouldReturn` 1000- setSocketOption sock UserTimeout 2000- getSocketOption sock UserTimeout `shouldReturn` 2000- close sock-- -- On various BSD systems the peer credentials are exchanged during- -- connect(), and this does not happen with `socketpair()`. Therefore,- -- we must actually set up a listener and connect, rather than use a- -- socketpair().- --- describe "getPeerCredential" $ do- it "can return something" $ do- when isUnixDomainSocketAvailable $ do- -- It would be useful to check that we did not get garbage- -- back, but rather the actual uid of the test program. For- -- that we'd need System.Posix.User, but that is not available- -- under Windows. For now, accept the risk that we did not get- -- the right answer.- --- let client sock = do- (_, uid, _) <- getPeerCredential sock- uid `shouldNotBe` Nothing- server (sock, _) = do- (_, uid, _) <- getPeerCredential sock- uid `shouldNotBe` Nothing- unixTest client server- {- The below test fails on many *BSD systems, because the getsockopt()- call that underlies getpeereid() does not have the same meaning for- all address families, but the C-library was not checking that the- provided sock is an AF_UNIX socket. This will fixed some day, but- we should not fail on those systems in the mean-time. The upstream- C-library fix is to call getsockname() and check the address family- before calling `getpeereid()`. We could duplicate that in our own- code, and then this test would work on those platforms that have- `getpeereid()` and not the SO_PEERCRED socket option.-- it "return nothing for non-UNIX-domain socket" $ do- when isUnixDomainSocketAvailable $ do- s <- socket AF_INET Stream defaultProtocol- cred1 <- getPeerCredential s- cred1 `shouldBe` (Nothing,Nothing,Nothing)- -}-- describe "getAddrInfo" $ do- it "works for IPv4 address" $ do- let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }- AddrInfo{addrAddress = (SockAddrInet _ hostAddr)}:_ <-- getAddrInfo (Just hints) (Just "127.128.129.130") Nothing- hostAddressToTuple hostAddr `shouldBe` (0x7f, 0x80, 0x81, 0x82)-#if defined(IPV6_SOCKET_SUPPORT)- it "works for IPv6 address" $ do- let hints = defaultHints { addrFlags = [AI_NUMERICHOST, AI_ADDRCONFIG] }- host = "2001:0db8:85a3:0000:0000:8a2e:0370:7334"- AddrInfo{addrAddress = (SockAddrInet6 _ _ hostAddr _)}:_ <-- getAddrInfo (Just hints) (Just host) Nothing- hostAddress6ToTuple hostAddr- `shouldBe` (0x2001, 0x0db8, 0x85a3, 0x0000, 0x0000, 0x8a2e, 0x0370, 0x7334)-#endif-- describe "unix sockets" $ do- it "basic unix sockets end-to-end" $ do- when isUnixDomainSocketAvailable $ do- let client sock = send sock testMsg- server (sock, addr) = do- recv sock 1024 `shouldReturn` testMsg- addr `shouldBe` (SockAddrUnix "")- unixTest client server-- describe "Lazy.sendAll" $ do- it "works well" $ do- let server sock = recv sock 1024 `shouldReturn` testMsg- client sock = Lazy.sendAll sock $ L.fromChunks [testMsg]- tcpTest client server----------------------------------------------------------------------------serverAddr :: String-serverAddr = "127.0.0.1"--testMsg :: ByteString-testMsg = "This is a test message."--unixAddr :: String-unixAddr = "/tmp/network-test"----------------------------------------------------------------------------- Test helpers---- | Establish a connection between client and server and then run--- 'clientAct' and 'serverAct', in different threads. Both actions--- get passed a connected 'Socket', used for communicating between--- client and server. 'unixTest' makes sure that the 'Socket' is--- closed after the actions have run.-unixTest :: (Socket -> IO a) -> ((Socket, SockAddr) -> IO b) -> IO ()-unixTest clientAct serverAct = do- test clientSetup clientAct serverSetup server- where- clientSetup = do- sock <- socket AF_UNIX Stream defaultProtocol- connect sock (SockAddrUnix unixAddr)- return sock-- serverSetup = do- sock <- socket AF_UNIX Stream defaultProtocol- unlink unixAddr -- just in case- bind sock (SockAddrUnix unixAddr)- listen sock 1- return sock-- server sock = E.bracket (accept sock) (killClientSock . fst) serverAct-- unlink file = do- exist <- doesFileExist file- when exist $ removeFile file-- killClientSock sock = do- shutdown sock ShutdownBoth- close sock- unlink unixAddr---- | Establish a connection between client and server and then run--- 'clientAct' and 'serverAct', in different threads. Both actions--- get passed a connected 'Socket', used for communicating between--- client and server. 'tcpTest' makes sure that the 'Socket' is--- closed after the actions have run.-tcpTest :: (Socket -> IO a) -> (Socket -> IO b) -> IO ()-tcpTest clientAct serverAct = do- tcpTestUsingClient serverAct clientAct clientSetup- where- clientSetup portVar = do- let hints = defaultHints { addrSocketType = Stream }- serverPort <- readMVar portVar- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) (Just $ show serverPort)- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)-#if !defined(mingw32_HOST_OS)- fd <- fdSocket sock- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` False-#endif- connect sock $ addrAddress addr- return sock--tcpTestUsingClient- :: (Socket -> IO a) -> (Socket -> IO b) -> (MVar PortNumber -> IO Socket) -> IO ()-tcpTestUsingClient serverAct clientAct clientSetup = do- portVar <- newEmptyMVar- test (clientSetup portVar) clientAct (serverSetup portVar) server- where- serverSetup portVar = do- let hints = defaultHints {- addrFlags = [AI_PASSIVE]- , addrSocketType = Stream- }- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)- fd <- fdSocket sock-#if !defined(mingw32_HOST_OS)- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` False-#endif- setSocketOption sock ReuseAddr 1- setCloseOnExecIfNeeded fd-#if !defined(mingw32_HOST_OS)- getCloseOnExec fd `shouldReturn` True-#endif- bind sock $ addrAddress addr- listen sock 1- serverPort <- socketPort sock- putMVar portVar serverPort- return sock-- server sock = do- (clientSock, _) <- accept sock-#if !defined(mingw32_HOST_OS)- fd <- fdSocket clientSock- getNonBlock fd `shouldReturn` True- getCloseOnExec fd `shouldReturn` True-#endif- _ <- serverAct clientSock- close clientSock---- | Create an unconnected 'Socket' for sending UDP and receiving--- datagrams and then run 'clientAct' and 'serverAct'.-udpTest :: (Socket -> PortNumber -> IO a) -> (Socket -> IO b) -> IO ()-udpTest clientAct serverAct = do- portVar <- newEmptyMVar- test clientSetup (client portVar) (serverSetup portVar) serverAct- where- clientSetup = socket AF_INET Datagram defaultProtocol-- client portVar sock = do- serverPort <- readMVar portVar- clientAct sock serverPort-- serverSetup portVar = do- let hints = defaultHints {- addrFlags = [AI_PASSIVE]- , addrSocketType = Datagram- }- addr:_ <- getAddrInfo (Just hints) (Just serverAddr) Nothing- sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)- setSocketOption sock ReuseAddr 1- bind sock $ addrAddress addr- serverPort <- socketPort sock- putMVar portVar serverPort- return sock---- | Run a client/server pair and synchronize them so that the server--- is started before the client and the specified server action is--- finished before the client closes the 'Socket'.-test :: IO Socket -> (Socket -> IO b) -> IO Socket -> (Socket -> IO c) -> IO ()-test clientSetup clientAct serverSetup serverAct = do- tid <- myThreadId- barrier <- newEmptyMVar- _ <- forkIO $ server barrier- client tid barrier- where- server barrier = do- E.bracket serverSetup close $ \sock -> do- serverReady- Just _ <- timeout 1000000 $ serverAct sock- putMVar barrier ()- where- -- | Signal to the client that it can proceed.- serverReady = putMVar barrier ()-- client tid barrier = do- takeMVar barrier- -- Transfer exceptions to the main thread.- bracketWithReraise tid clientSetup close $ \res -> do- Just _ <- timeout 1000000 $ clientAct res- takeMVar barrier---- | Like 'bracket' but catches and reraises the exception in another--- thread, specified by the first argument.-bracketWithReraise :: ThreadId -> IO a -> (a -> IO b) -> (a -> IO ()) -> IO ()-bracketWithReraise tid setup teardown thing =- E.bracket setup teardown thing- `E.catch` \ (e :: E.SomeException) -> E.throwTo tid e