network-transport-tcp 0.4.0 → 0.4.1

raw patch · 5 files changed

+62/−23 lines, 5 filesdep ~networkdep ~network-transportdep ~network-transport-testsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: network, network-transport, network-transport-tests

API changes (from Hackage documentation)

Files

• ChangeLog +4/−0
• network-transport-tcp.cabal +13/−9
• src/Network/Transport/TCP.hs +18/−8
• src/Network/Transport/TCP/Internal.hs +12/−6
• tests/TestTCP.hs +15/−0

@@ -1,3 +1,7 @@+2014-12-09  Tim Watson  <watson.timothy@gmail.com>  0.4.1++* Update dependencies+ 2014-05-30  Tim Watson  <watson.timothy@gmail.com>  0.4.0  * Update dependencies

@@ -1,6 +1,6 @@ Name:          network-transport-tcp-Version:       0.4.0-Cabal-Version: >=1.8+Version:       0.4.1+Cabal-Version: >=1.10 Build-Type:    Simple License:       BSD3  License-file:  LICENSE@@ -12,7 +12,7 @@ Bug-Reports:   https://cloud-haskell.atlassian.net/browse/NTTCP Synopsis:      TCP instantiation of Network.Transport Description:   TCP instantiation of Network.Transport  -Tested-With:   GHC==7.0.4 GHC==7.2.2 GHC==7.4.1 GHC==7.4.2+Tested-With:   GHC==7.0.4 GHC==7.2.2 GHC==7.4.1 GHC==7.4.2 GHC==7.6.2 Category:      Network extra-source-files: ChangeLog @@ -26,14 +26,16 @@  Library   Build-Depends:   base >= 4.3 && < 5,-                   network-transport >= 0.4.0.0 && < 0.5,+                   network-transport >= 0.4.1.0 && < 0.5,                    data-accessor >= 0.2 && < 0.3,                    containers >= 0.4 && < 0.6,                    bytestring >= 0.9 && < 0.11,-                   network >= 2.3 && < 2.5+                   network >= 2.3 && < 2.7   Exposed-modules: Network.Transport.TCP,                    Network.Transport.TCP.Internal-  Extensions:      CPP+  Default-Extensions: CPP+  default-language: Haskell2010+  Other-Extensions:   RecursiveDo   ghc-options:     -Wall -fno-warn-unused-do-bind   HS-Source-Dirs:  src   If flag(use-mock-network)@@ -45,14 +47,15 @@   Type:            exitcode-stdio-1.0   Main-Is:         TestTCP.hs   Build-Depends:   base >= 4.3 && < 5,-                   network-transport-tests >= 0.1.0.1 && < 0.2,-                   network >= 2.3 && < 2.5,-                   network-transport >= 0.4.0.0 && < 0.5,+                   network-transport-tests >= 0.2.1.0 && < 0.3,+                   network >= 2.3 && < 2.7,+                   network-transport >= 0.4.1.0 && < 0.5,                    network-transport-tcp >= 0.3 && < 0.5   ghc-options:     -threaded -rtsopts -with-rtsopts=-N   HS-Source-Dirs:  tests   Extensions:      CPP,                    OverloadedStrings+  default-language: Haskell2010   If flag(use-mock-network)     CPP-Options:   -DUSE_MOCK_NETWORK @@ -86,3 +89,4 @@                   OverloadedStrings                   DeriveDataTypeable                   MultiParamTypeClasses+  default-language: Haskell2010

@@ -10,6 +10,10 @@ -- Applications that use the TCP transport should use -- 'Network.Socket.withSocketsDo' in their main function for Windows -- compatibility (see "Network.Socket").++{-# LANGUAGE RecursiveDo #-}+{-# LANGUAGE TupleSections #-}+ module Network.Transport.TCP   ( -- * Main API     createTransport@@ -480,20 +484,26 @@       { _localEndPoints = Map.empty       , _nextEndPointId = 0       }-    let transport = TCPTransport { transportState  = state-                                 , transportHost   = host-                                 , transportPort   = port-                                 , transportParams = params-                                 }-    tryIO $ bracketOnError (forkServer+    tryIO $ mdo+       -- We don't know for sure the actual port 'forkServer' binded until it+       -- completes (see description of 'forkServer'), yet we need the port to+       -- construct a transport. So we tie a recursive knot.+       (port', result) <- do+         let transport = TCPTransport { transportState  = state+                                      , transportHost   = host+                                      , transportPort   = port'+                                      , transportParams = params+                                      }+         bracketOnError (forkServer                              host                              port                              (tcpBacklog params)                              (tcpReuseServerAddr params)                              (terminationHandler transport)                              (handleConnectionRequest transport))-                           killThread-                           (mkTransport transport)+                      (\(_port', tid) -> killThread tid)+                      (\(port'', tid) -> (port'',) <$> mkTransport transport tid)+       return result   where     mkTransport :: TCPTransport                 -> ThreadId

@@ -34,6 +34,7 @@   , setSocketOption   , accept   , sClose+  , socketPort   )  #ifdef USE_MOCK_NETWORK@@ -45,7 +46,7 @@ import Control.Concurrent (ThreadId) import Control.Monad (forever, when) import Control.Exception (SomeException, catch, bracketOnError, throwIO, mask_)-import Control.Applicative ((<$>))+import Control.Applicative ((<$>), (<*>)) import Data.ByteString (ByteString) import qualified Data.ByteString as BS (length, concat, null) import Data.Int (Int32)@@ -68,13 +69,17 @@ -- or the server will block. Once a thread has been spawned it will be the -- responsibility of the new thread to close the socket when an exception -- occurs.+--+-- The return value includes the port was bound to. This is not always the same+-- port as that given in the argument. For example, binding to port 0 actually+-- binds to a random port, selected by the OS. forkServer :: N.HostName               -- ^ Host            -> N.ServiceName            -- ^ Port            -> Int                      -- ^ Backlog (maximum number of queued connections)            -> Bool                     -- ^ Set ReuseAddr option?            -> (SomeException -> IO ()) -- ^ Termination handler            -> (N.Socket -> IO ())      -- ^ Request handler-           -> IO ThreadId+           -> IO (N.ServiceName, ThreadId) forkServer host port backlog reuseAddr terminationHandler requestHandler = do     -- Resolve the specified address. By specification, getAddrInfo will never     -- return an empty list (but will throw an exception instead) and will return@@ -91,10 +96,11 @@       -- /before/ any asynchronous exception occurs. So we mask_, then fork       -- (the child thread inherits the masked state from the parent), then       -- unmask only inside the catch.-      mask_ $ forkIOWithUnmask $ \unmask ->-        catch (unmask (forever $ acceptRequest sock)) $ \ex -> do-          tryCloseSocket sock-          terminationHandler ex+      (,) <$> fmap show (N.socketPort sock) <*>+        (mask_ $ forkIOWithUnmask $ \unmask ->+          catch (unmask (forever $ acceptRequest sock)) $ \ex -> do+            tryCloseSocket sock+            terminationHandler ex)   where     acceptRequest :: N.Socket -> IO ()     acceptRequest sock = bracketOnError (N.accept sock)

@@ -773,6 +773,20 @@    mapM_ takeMVar [clientDone, serverDone] +testUseRandomPort :: IO ()+testUseRandomPort = do+   testDone <- newEmptyMVar+   forkTry $ do+     Right transport1 <- createTransport "127.0.0.1" "0" defaultTCPParameters+     Right ep1        <- newEndPoint transport1+     Right transport2 <- createTransport "127.0.0.1" "0" defaultTCPParameters+     Right ep2        <- newEndPoint transport2+     Right conn1 <- connect ep2 (address ep1) ReliableOrdered defaultConnectHints+     ConnectionOpened _ _ _ <- receive ep1+     putMVar testDone ()+   takeMVar testDone++ main :: IO () main = do   portMVar <- newEmptyMVar@@ -791,6 +805,7 @@            , ("Reconnect",              testReconnect nextPort)            , ("UnidirectionalError",    testUnidirectionalError nextPort)            , ("InvalidCloseConnection", testInvalidCloseConnection nextPort)+           , ("Use random port"       , testUseRandomPort)            ]   -- Run the generic tests even if the TCP specific tests failed..   testTransport (either (Left . show) (Right) <$> nextPort >>= \port -> createTransport "127.0.0.1" port defaultTCPParameters)