network 3.2.8.0 → 3.2.9.0

raw patch · 10 files changed

+140/−131 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Network/Socket.hs +1/−0
• Network/Socket/Buffer.hsc +2/−0
• Network/Socket/Info.hsc +0/−63
• Network/Socket/Internal.hs +46/−40
• Network/Socket/SockAddr.hs +5/−5
• Network/Socket/Types.hsc +59/−0
• network.cabal +1/−1
• tests/Network/SocketSpec.hs +22/−18
• tests/Network/Test/Common.hs +0/−4

@@ -1,5 +1,9 @@ # CHANGELOG for network +## Version 3.2.9.0++* Exporting recvBufNoWait.+ ## Version 3.2.8.0  * sockopt: add IP_DONTFRAG/IP_MTU_DISCOVER option.

@@ -344,6 +344,7 @@     -- ** Sending and receiving data     sendBuf,     recvBuf,+    recvBufNoWait,     sendBufTo,     recvBufFrom, 

@@ -159,6 +159,8 @@ --   involved. The length of data is returned if received. --   -1 is returned in the case of EAGAIN or EWOULDBLOCK. --   -2 is returned in other error cases.+--+-- @since 3.2.9.0 recvBufNoWait :: Socket -> Ptr Word8 -> Int -> IO Int recvBufNoWait s ptr nbytes = withFdSocket s $ \fd -> do #if defined(mingw32_HOST_OS)

@@ -1,6 +1,5 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}  #include "HsNet.h" ##include "HsNetDef.h"@@ -446,68 +445,6 @@ unpackBits ((k,v):xs) r     | r .&. v /= 0 = k : unpackBits xs (r .&. complement v)     | otherwise    = unpackBits xs r---------------------------------------------------------------------------------- SockAddr---- |------ >>> SockAddrInet6 80 0 (0,0,0xffff,0x01020304) 0--- [::ffff:1.2.3.4]:80-instance Show SockAddr where-  showsPrec _ (SockAddrUnix str) = showString str-  showsPrec _ (SockAddrInet port ha)-   = showHostAddress ha-   . showString ":"-   . shows port-  showsPrec _ (SockAddrInet6 port _ ha6 _)-   = showChar '['-   . showHostAddress6 ha6-   . showString "]:"-   . shows port----- Taken from on the implementation of showIPv4 in Data.IP.Addr-showHostAddress :: HostAddress -> ShowS-showHostAddress ip =-  let (u3, u2, u1, u0) = hostAddressToTuple ip in-  foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]--showHostAddress' :: HostAddress -> ShowS-showHostAddress' ip =-  let (u3, u2, u1, u0) = hostAddressToTuple' ip in-  foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]---- Taken from showIPv6 in Data.IP.Addr.---- | Show an IPv6 address in the most appropriate notation, based on recommended--- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.------ /The implementation is completely compatible with the current implementation--- of the `inet_ntop` function in glibc./-showHostAddress6 :: HostAddress6 -> ShowS-showHostAddress6 ha6@(a1, a2, a3, a4)-    -- IPv4-Mapped IPv6 Address-    | a1 == 0 && a2 == 0 && a3 == 0xffff =-      showString "::ffff:" . showHostAddress' a4-    -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)-    | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 =-        showString "::" . showHostAddress' a4-    -- length of longest run > 1, replace it with "::"-    | end - begin > 1 =-        showFields prefix . showString "::" . showFields suffix-    | otherwise =-        showFields fields-  where-    fields =-        let (u7, u6, u5, u4, u3, u2, u1, u0) = hostAddress6ToTuple ha6 in-        [u7, u6, u5, u4, u3, u2, u1, u0]-    showFields = foldr (.) id . intersperse (showChar ':') . map showHex-    prefix = take begin fields  -- fields before "::"-    suffix = drop end fields    -- fields after "::"-    begin = end + diff          -- the longest run of zeros-    (diff, end) = minimum $-        scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..]  ----------------------------------------------------------------------------- 

@@ -84,11 +84,26 @@ -- | Throw an 'IOError' corresponding to the current socket error. throwSocketError :: String  -- ^ textual description of the error location                  -> IO a+#if defined(mingw32_HOST_OS)+throwSocketError name =+    c_getLastError >>= throwSocketErrorCode name+#else+throwSocketError = throwErrno+#endif  -- | Like 'throwSocketError', but the error code is supplied as an argument. -- -- On Windows, do not use errno.  Use a system error code instead. throwSocketErrorCode :: String -> CInt -> IO a+#if defined(mingw32_HOST_OS)+throwSocketErrorCode name rc = do+    pstr <- c_getWSError rc+    str  <- peekCString pstr+    ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str)+#else+throwSocketErrorCode loc errno =+    ioError (errnoToIOError loc (Errno errno) Nothing Nothing)+#endif  -- | Throw an 'IOError' corresponding to the current socket error if -- the IO action returns a result of @-1@.  Discards the result of the@@ -98,6 +113,13 @@     => String  -- ^ textual description of the location     -> IO a    -- ^ the 'IO' operation to be executed     -> IO ()+#if defined(mingw32_HOST_OS)+throwSocketErrorIfMinus1_ name act = do+  _ <- throwSocketErrorIfMinus1Retry name act+  return ()+#else+throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry+#endif  {-# SPECIALIZE throwSocketErrorIfMinus1_ :: String -> IO CInt -> IO () #-} @@ -109,6 +131,12 @@     => String  -- ^ textual description of the location     -> IO a    -- ^ the 'IO' operation to be executed     -> IO a+#if defined(mingw32_HOST_OS)+throwSocketErrorIfMinus1Retry+  = throwSocketErrorIfMinus1ButRetry (const False)+#else+throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_+#endif  {-# SPECIALIZE throwSocketErrorIfMinus1Retry :: String -> IO CInt -> IO CInt #-} @@ -136,6 +164,13 @@                --   immediate retry would block     -> IO a    -- ^ the 'IO' operation to be executed     -> IO a+#if defined(mingw32_HOST_OS)+throwSocketErrorIfMinus1RetryMayBlock name _ act+  = throwSocketErrorIfMinus1Retry name act+#else+throwSocketErrorIfMinus1RetryMayBlock name on_block act =+    throwErrnoIfMinus1RetryMayBlock name act on_block+#endif  {-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock         :: String -> IO b -> IO CInt -> IO CInt #-}@@ -154,22 +189,20 @@                       --   immediate retry would block     -> IO a           -- ^ the 'IO' operation to be executed     -> IO a--{-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock-        :: String -> IO b -> IO CInt -> IO CInt #-}- #if defined(mingw32_HOST_OS)--throwSocketErrorIfMinus1RetryMayBlock name _ act-  = throwSocketErrorIfMinus1Retry name act- throwSocketErrorIfMinus1RetryMayBlockBut exempt name _ act   = throwSocketErrorIfMinus1ButRetry exempt name act+#else+throwSocketErrorIfMinus1RetryMayBlockBut _exempt name on_block act =+    throwErrnoIfMinus1RetryMayBlock name act on_block+#endif -throwSocketErrorIfMinus1_ name act = do-  _ <- throwSocketErrorIfMinus1Retry name act-  return ()+{-# SPECIALIZE throwSocketErrorIfMinus1RetryMayBlock+        :: String -> IO b -> IO CInt -> IO CInt #-} +-- ---------------------------------------------------------------------++#if defined(mingw32_HOST_OS) throwSocketErrorIfMinus1ButRetry :: (Eq a, Num a) =>                                     (CInt -> Bool) -> String -> IO a -> IO a throwSocketErrorIfMinus1ButRetry exempt name act = do@@ -189,41 +222,14 @@           else throwSocketError name    else return r -throwSocketErrorIfMinus1Retry-  = throwSocketErrorIfMinus1ButRetry (const False)--throwSocketErrorCode name rc = do-    pstr <- c_getWSError rc-    str  <- peekCString pstr-    ioError (ioeSetErrorString (mkIOError OtherError name Nothing Nothing) str)--throwSocketError name =-    c_getLastError >>= throwSocketErrorCode name- foreign import CALLCONV unsafe "WSAGetLastError"   c_getLastError :: IO CInt  foreign import ccall unsafe "getWSErrorDescr"   c_getWSError :: CInt -> IO (Ptr CChar)--#else--throwSocketErrorIfMinus1RetryMayBlock name on_block act =-    throwErrnoIfMinus1RetryMayBlock name act on_block--throwSocketErrorIfMinus1RetryMayBlockBut _exempt name on_block act =-    throwErrnoIfMinus1RetryMayBlock name act on_block--throwSocketErrorIfMinus1Retry = throwErrnoIfMinus1Retry--throwSocketErrorIfMinus1_ = throwErrnoIfMinus1_--throwSocketError = throwErrno--throwSocketErrorCode loc errno =-    ioError (errnoToIOError loc (Errno errno) Nothing Nothing)- #endif++-- ---------------------------------------------------------------------  -- | Like 'throwSocketErrorIfMinus1Retry', but if the action fails with -- @EWOULDBLOCK@ or similar, wait for the socket to be read-ready,

@@ -46,25 +46,25 @@ -- 'defaultPort' is passed then the system assigns the next available -- use port. bind :: Socket -> SockAddr -> IO ()-bind s a = case a of+bind s sa = case sa 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)+        res <- try (G.bind s sa)         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)+                res2 <- try (G.connect s sa)                 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+                        G.bind s sa+    _ -> G.bind s sa  -- | Accept a connection.  The socket must be bound to an address and -- listening for connections.  The return value is a pair @(conn,

@@ -1084,6 +1084,65 @@   rnf (SockAddrInet6 _ _ _ _) = ()   rnf (SockAddrUnix str) = rnf str +-- |+--+-- >>> SockAddrInet6 80 0 (0,0,0xffff,0x01020304) 0+-- [::ffff:1.2.3.4]:80+instance Show SockAddr where+  showsPrec _ (SockAddrUnix str) = showString str+  showsPrec _ (SockAddrInet port ha)+   = showHostAddress ha+   . showString ":"+   . shows port+  showsPrec _ (SockAddrInet6 port _ ha6 _)+   = showChar '['+   . showHostAddress6 ha6+   . showString "]:"+   . shows port+++-- Taken from on the implementation of showIPv4 in Data.IP.Addr+showHostAddress :: HostAddress -> ShowS+showHostAddress ip =+  let (u3, u2, u1, u0) = hostAddressToTuple ip in+  foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]++showHostAddress' :: HostAddress -> ShowS+showHostAddress' ip =+  let (u3, u2, u1, u0) = hostAddressToTuple' ip in+  foldr1 (.) . intersperse (showChar '.') $ map showInt [u3, u2, u1, u0]++-- Taken from showIPv6 in Data.IP.Addr.++-- | Show an IPv6 address in the most appropriate notation, based on recommended+-- representation proposed by <http://tools.ietf.org/html/rfc5952 RFC 5952>.+--+-- /The implementation is completely compatible with the current implementation+-- of the `inet_ntop` function in glibc./+showHostAddress6 :: HostAddress6 -> ShowS+showHostAddress6 ha6@(a1, a2, a3, a4)+    -- IPv4-Mapped IPv6 Address+    | a1 == 0 && a2 == 0 && a3 == 0xffff =+      showString "::ffff:" . showHostAddress' a4+    -- IPv4-Compatible IPv6 Address (exclude IPRange ::/112)+    | a1 == 0 && a2 == 0 && a3 == 0 && a4 >= 0x10000 =+        showString "::" . showHostAddress' a4+    -- length of longest run > 1, replace it with "::"+    | end - begin > 1 =+        showFields prefix . showString "::" . showFields suffix+    | otherwise =+        showFields fields+  where+    fields =+        let (u7, u6, u5, u4, u3, u2, u1, u0) = hostAddress6ToTuple ha6 in+        [u7, u6, u5, u4, u3, u2, u1, u0]+    showFields = foldr (.) id . intersperse (showChar ':') . map showHex+    prefix = take begin fields  -- fields before "::"+    suffix = drop end fields    -- fields after "::"+    begin = end + diff          -- the longest run of zeros+    (diff, end) = minimum $+        scanl (\c i -> if i == 0 then c - 1 else 0) 0 fields `zip` [0..]+ -- | Is the socket address type supported on this system? isSupportedSockAddr :: SockAddr -> Bool isSupportedSockAddr addr = case addr of

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               network-version:            3.2.8.0+version:            3.2.9.0 license:            BSD3 license-file:       LICENSE maintainer:         Kazu Yamamoto, Tamar Christina

@@ -158,11 +158,13 @@     when isUnixDomainSocketAvailable $ do         context "unix sockets" $ do             it "basic unix sockets end-to-end" $ do-                let client sock = send sock testMsg-                    server (sock, addr) = do-                        recv sock 1024 `shouldReturn` testMsg-                        addr `shouldBe` (SockAddrUnix "")-                test . setClientAction client $ unixWithUnlink unixAddr server+                withSystemTempDirectory "haskell-network" $ \path -> do+                    let unixAddr = path ++ "/socket-file"+                    let client sock = send sock testMsg+                        server (sock, addr) = do+                            recv sock 1024 `shouldReturn` testMsg+                            addr `shouldBe` (SockAddrUnix "")+                    test . setClientAction client $ unixWithUnlink unixAddr server #endif  #ifdef linux_HOST_OS@@ -208,19 +210,21 @@         --         describe "getPeerCredential" $ do             it "can return something" $ 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 server (sock, _) = do-                        (_, uid, _) <- getPeerCredential sock-                        uid `shouldNotBe` Nothing-                    client sock = do-                        (_, uid, _) <- getPeerCredential sock-                        uid `shouldNotBe` Nothing-                test . setClientAction client $ unixWithUnlink unixAddr server+                withSystemTempDirectory "haskell-network" $ \path -> do+                    let unixAddr = path ++ "/socket-file"+                    -- 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 server (sock, _) = do+                            (_, uid, _) <- getPeerCredential sock+                            uid `shouldNotBe` Nothing+                        client sock = do+                            (_, uid, _) <- getPeerCredential sock+                            uid `shouldNotBe` Nothing+                    test . setClientAction client $ unixWithUnlink unixAddr 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

@@ -21,7 +21,6 @@   -- * Common constants   , serverAddr   , serverAddr6-  , unixAddr   , testMsg   , lazyTestMsg   ) where@@ -52,9 +51,6 @@  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