Split Network.Transport. THIS BREAKS THE CH BUILD.

Starting to prepare for release. Have not yet updated the CH build to reflect
the changes.

network-transport-inmemory/LICENSE

@@ -0,0 +1,31 @@
+Copyright Well-Typed LLP, 2011-2012
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the owner nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+

network-transport-inmemory/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

network-transport-inmemory/network-transport-inmemory.cabal

@@ -0,0 +1,64 @@
+Name:          network-transport-inmemory
+Version:       0.2.0
+Cabal-Version: >=1.8
+Build-Type:    Simple
+License:       BSD3 
+License-file:  LICENSE
+Copyright:     Well-Typed LLP
+Author:        Duncan Coutts, Nicolas Wu, Edsko de Vries
+Maintainer:    edsko@well-typed.com, dcoutts@well-typed.com
+Stability:     experimental
+Homepage:      http://github.com/haskell-distributed/distributed-process
+Bug-Reports:   mailto:edsko@well-typed.com
+Synopsis:      In-memory instantation of Network.Transport
+Description:   In-memory instantation of Network.Transport  
+Tested-With:   GHC==7.0.4 GHC==7.2.2 GHC==7.4.1 GHC==7.4.2
+Category:      Network  
+
+Library
+  Build-Depends:   base >= 4.3 && < 5,
+                   network-transport >= 0.2 && < 0.3,
+                   data-accessor >= 0.2 && < 0.3,
+                   bytestring >= 0.9 && < 0.10,
+                   containers >= 0.4 && < 0.5
+  Exposed-modules: Network.Transport.Chan
+  ghc-options:     -Wall -fno-warn-unused-do-bind
+  HS-Source-Dirs:  src
+
+Test-Suite TestMulticastInMemory 
+  Type:            exitcode-stdio-1.0
+  Build-Depends:   base >= 4.3 && < 5,
+                   network-transport >= 0.2 && < 0.3,
+                   data-accessor >= 0.2 && < 0.3,
+                   bytestring >= 0.9 && < 0.10,
+                   containers >= 0.4 && < 0.5,
+                   random >= 1.0 && < 1.1,
+                   ansi-terminal >= 0.5 && < 0.6
+  Main-Is:         TestMulticastInMemory.hs
+  ghc-options:     -Wall -fno-warn-unused-do-bind
+  Extensions:      ExistentialQuantification,
+                   FlexibleInstances,
+                   DeriveDataTypeable,
+                   RankNTypes,
+                   OverloadedStrings
+  HS-Source-Dirs:  tests src
+
+Test-Suite TestInMemory 
+  Type:            exitcode-stdio-1.0
+  Build-Depends:   base >= 4.3 && < 5,
+                   network-transport >= 0.2 && < 0.3,
+                   data-accessor >= 0.2 && < 0.3,
+                   bytestring >= 0.9 && < 0.10,
+                   containers >= 0.4 && < 0.5,
+                   random >= 1.0 && < 1.1,
+                   ansi-terminal >= 0.5 && < 0.6,
+                   mtl >= 2.0 && < 2.2
+  Main-Is:         TestInMemory.hs
+  ghc-options:     -Wall -fno-warn-unused-do-bind
+  Extensions:      ExistentialQuantification,
+                   FlexibleInstances,
+                   DeriveDataTypeable,
+                   RankNTypes,
+                   OverloadedStrings,
+                   OverlappingInstances
+  HS-Source-Dirs:  tests src

network-transport-tcp/LICENSE

@@ -0,0 +1,31 @@
+Copyright Well-Typed LLP, 2011-2012
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the owner nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+

network-transport-tcp/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

network-transport-tcp/network-transport-tcp.cabal

@@ -0,0 +1,49 @@
+Name:          network-transport-tcp
+Version:       0.2.0
+Cabal-Version: >=1.8
+Build-Type:    Simple
+License:       BSD3 
+License-file:  LICENSE
+Copyright:     Well-Typed LLP
+Author:        Duncan Coutts, Nicolas Wu, Edsko de Vries
+Maintainer:    edsko@well-typed.com, dcoutts@well-typed.com
+Stability:     experimental
+Homepage:      http://github.com/haskell-distributed/distributed-process
+Bug-Reports:   mailto:edsko@well-typed.com
+Synopsis:      TCP instantation of Network.Transport
+Description:   TCP instantation of Network.Transport  
+Tested-With:   GHC==7.0.4 GHC==7.2.2 GHC==7.4.1 GHC==7.4.2
+Category:      Network  
+
+Library
+  Build-Depends:   base >= 4.3 && < 5,
+                   network-transport >= 0.2 && < 0.3,
+                   data-accessor >= 0.2 && < 0.3,
+                   containers >= 0.4 && < 0.5,
+                   bytestring >= 0.9 && < 0.10,
+                   network >= 2.3 && < 2.4
+  Exposed-modules: Network.Transport.TCP,
+                   Network.Transport.TCP.Internal
+  ghc-options:     -Wall -fno-warn-unused-do-bind
+  HS-Source-Dirs:  src
+
+Test-Suite TestTCP 
+  Type:            exitcode-stdio-1.0
+  Main-Is:         TestTCP.hs
+  Build-Depends:   base >= 4.3 && < 5,
+                   network-transport >= 0.2 && < 0.3,
+                   data-accessor >= 0.2 && < 0.3,
+                   containers >= 0.4 && < 0.5,
+                   bytestring >= 0.9 && < 0.10,
+                   network >= 2.3 && < 2.4,
+                   random >= 1.0 && < 1.1,
+                   ansi-terminal >= 0.5 && < 0.6,
+                   mtl >= 2.0 && < 2.2
+  ghc-options:     -Wall -fno-warn-unused-do-bind -threaded -rtsopts -with-rtsopts=-N
+  Extensions:      ExistentialQuantification,
+                   FlexibleInstances,
+                   DeriveDataTypeable,
+                   RankNTypes,
+                   OverlappingInstances,
+                   OverloadedStrings
+  HS-Source-Dirs:  tests src

network-transport/src/Network/Transport/TCP.hs → network-transport-tcp/src/Network/Transport/TCP.hs

@@ -30,7 +30,7 @@ module Network.Transport.TCP ( -- * Main API
 
 import Prelude hiding (catch, mapM_)
 import Network.Transport
-import Network.Transport.Internal.TCP ( forkServer
+import Network.Transport.TCP.Internal ( forkServer
                                       , recvWithLength
                                       , recvInt32
                                       , tryCloseSocket
@@ -364,8 +364,16 @@ data ValidRemoteEndPointState = ValidRemoteEndPointState
   , _nextCtrlRequestId   :: !ControlRequestId 
   }
 
+-- | Local identifier for an endpoint within this transport
 type EndPointId       = Int32
+
+-- | Control request ID
+-- 
+-- Control requests are asynchronous; the request ID makes it possible to match
+-- requests and replies
 type ControlRequestId = Int32
+
+-- | Pair of local and a remote endpoint (for conciseness in signatures)
 type EndPointPair     = (LocalEndPoint, RemoteEndPoint)
 
 -- | Control headers 
@@ -380,7 +388,7 @@ data ControlHeader =
   | CloseSocket         
   deriving (Enum, Bounded, Show)
 
--- Response sent by /B/ to /A/ when /A/ tries to connect
+-- | Response sent by /B/ to /A/ when /A/ tries to connect
 data ConnectionRequestResponse =
     -- | /B/ accepts the connection
     ConnectionRequestAccepted        
@@ -390,7 +398,7 @@ data ConnectionRequestResponse =
   | ConnectionRequestCrossed         
   deriving (Enum, Bounded, Show)
 
--- Parameters for setting up the TCP transport
+-- | Parameters for setting up the TCP transport
 data TCPParameters = TCPParameters {
     -- | Backlog for 'listen'.
     -- Defaults to SOMAXCONN.
@@ -403,7 +411,7 @@ data TCPParameters = TCPParameters {
   , tcpReuseClientAddr :: Bool
   }
 
--- Internal functionality we expose for unit testing
+-- | Internal functionality we expose for unit testing
 data TransportInternals = TransportInternals 
   { -- | The ID of the thread that listens for new incoming connections
     transportThread :: ThreadId

network-transport/src/Network/Transport/Internal/TCP.hs → network-transport-tcp/src/Network/Transport/TCP/Internal.hs

@@ -1,5 +1,5 @@
 -- | Utility functions for TCP sockets 
-module Network.Transport.Internal.TCP ( forkServer
+module Network.Transport.TCP.Internal ( forkServer
                                       , recvWithLength
                                       , recvExact 
                                       , recvInt32

network-transport-tcp/tests/TestAuxiliary.hs

@@ -0,0 +1,108 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module TestAuxiliary ( -- Running tests
+                       runTest
+                     , runTests
+                       -- Writing tests
+                     , forkTry
+                     , trySome
+                     , randomThreadDelay
+                     ) where
+
+import Prelude hiding (catch)
+import Control.Concurrent (myThreadId, forkIO, ThreadId, throwTo, threadDelay)
+import Control.Concurrent.Chan (Chan)
+import Control.Monad (liftM2, unless)
+import Control.Exception (SomeException, try, catch)
+import System.Timeout (timeout)
+import System.IO (stdout, hFlush)
+import System.Console.ANSI ( SGR(SetColor, Reset)
+                           , Color(Red, Green)
+                           , ConsoleLayer(Foreground)
+                           , ColorIntensity(Vivid)
+                           , setSGR
+                           )
+import System.Random (randomIO)
+import Network.Transport
+import Traced (Traceable(..), traceShow)
+
+-- | Like fork, but throw exceptions in the child thread to the parent
+forkTry :: IO () -> IO ThreadId 
+forkTry p = do
+  tid <- myThreadId
+  forkIO $ catch p (\e -> throwTo tid (e :: SomeException))
+
+-- | Like try, but specialized to SomeException
+trySome :: IO a -> IO (Either SomeException a)
+trySome = try
+
+-- | Run the given test, catching timeouts and exceptions
+runTest :: String -> IO () -> IO Bool 
+runTest description test = do
+  putStr $ "Running " ++ show description ++ ": "
+  hFlush stdout
+  done <- try . timeout 60000000 $ test -- 60 seconds
+  case done of
+    Left err        -> failed $ "(exception: " ++ show (err :: SomeException) ++ ")" 
+    Right Nothing   -> failed $ "(timeout)"
+    Right (Just ()) -> ok 
+  where
+    failed :: String -> IO Bool 
+    failed err = do
+      setSGR [SetColor Foreground Vivid Red]
+      putStr "failed "
+      setSGR [Reset]
+      putStrLn err
+      return False
+
+    ok :: IO Bool 
+    ok = do
+      setSGR [SetColor Foreground Vivid Green]
+      putStrLn "ok"
+      setSGR [Reset]
+      return True
+
+-- | Run a bunch of tests and throw an exception if any fails 
+runTests :: [(String, IO ())] -> IO ()
+runTests tests = do
+  success <- foldr (liftM2 (&&) . uncurry runTest) (return True) $ tests
+  unless success $ fail "Some tests failed"
+
+-- | Random thread delay between 0 and the specified max 
+randomThreadDelay :: Int -> IO ()
+randomThreadDelay maxDelay = do
+  delay <- randomIO :: IO Int
+  threadDelay (delay `mod` maxDelay) 
+
+--------------------------------------------------------------------------------
+-- traceShow instances                                                            -- 
+--------------------------------------------------------------------------------
+
+instance Traceable EndPoint where
+  trace = const Nothing
+
+instance Traceable Transport where
+  trace = const Nothing 
+
+instance Traceable Connection where
+  trace = const Nothing 
+
+instance Traceable Event where
+  trace = traceShow 
+
+instance Show err => Traceable (TransportError err) where
+  trace = traceShow 
+
+instance Traceable EndPointAddress where
+  trace = traceShow . endPointAddressToByteString
+
+instance Traceable SomeException where
+  trace = traceShow
+
+instance Traceable ThreadId where
+  trace = const Nothing
+
+instance Traceable (Chan a) where
+  trace = const Nothing
+
+instance Traceable Float where
+  trace = traceShow

network-transport/tests/TestTCP.hs → network-transport-tcp/tests/TestTCP.hs

@@ -36,7 +36,7 @@ import Network.Transport.Internal ( encodeInt32
                                   , tryIO
                                   , void
                                   )
-import Network.Transport.Internal.TCP (recvInt32, forkServer, recvWithLength)
+import Network.Transport.TCP.Internal (recvInt32, forkServer, recvWithLength)
 import qualified Network.Socket as N ( sClose
                                      , ServiceName
                                      , Socket