public
Last active

network-conduit hangs in clientSrc $$ serverSink?

  • Download Gist
netproxy6.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS -Wall #-}
import Data.Conduit
import Data.Conduit.Network
import Control.Monad.IO.Class (liftIO)
import Control.Concurrent.Lifted (fork,threadDelay)
import Network (withSocketsDo)
import qualified Control.Exception.Lifted as EL
import Control.Monad.Trans.Resource
 
main::IO ()
main = do
withSocketsDo $ runTCPClient (ClientSettings 5000 "127.0.0.1") $ \clientSrc clientSink -> do
liftIO $ putStrLn $ "attaching runTcpClient"
liftIO $ withSocketsDo $ runTCPServer (ServerSettings 5002 (Just "127.0.0.1")) $ \serverSrc serverSink -> do
liftIO $ putStrLn $ "\nNEW runTcpServer session"
_ <- liftIO $ fork $ do
liftIO $ putStrLn "START clientSrc serverSink"
runResourceT $ do
_ <- register $ liftIO $ putStrLn ("finalizer clientSrc serverSink") -- Doesnt fire
EL.catch (clientSrc $$ serverSink) (\(e::EL.SomeException) -> liftIO (putStrLn ("Exception:clientSrc serverSink e[" ++ show e ++ "]"))) -- no errors until the process is killed
liftIO $ putStrLn "END clientSrc serverSink" -- never gets this far
liftIO $ putStrLn "START serverSrc clientSink"
EL.catch (serverSrc $$ clientSink) (\(e::EL.SomeException) -> liftIO (putStrLn ("Exception:serverSrc clientSink e[" ++ show e ++ "]")))
liftIO $ putStrLn "END serverSrc clientSink"
putStrLn $ "END runTcpClient"
 
-- on Ubuntu
{-
grant@grant-VirtualBox:~/haskell$ ./netproxy6
attaching runTcpClient
 
NEW runTcpServer session
START clientSrc serverSink
START serverSrc clientSink
END serverSrc clientSink
 
NEW runTcpServer session
START serverSrc clientSink
START clientSrc serverSink
END serverSrc clientSink
 
NEW runTcpServer session
START clientSrc serverSink
START serverSrc clientSink
END serverSrc clientSink
^CException:clientSrc serverSink e[recv: invalid argument (Bad file descriptor)]
END clientSrc serverSink
finalizer clientSrc serverSink
Exception:clientSrc serverSink e[recv: invalid argument (Bad file descriptor)]
END clientSrc serverSink
finalizer clientSrc serverSink
Exception:clientSrc serverSink e[recv: invalid argument (Bad file descriptor)]
END clientSrc serverSink
finalizer clientSrc serverSink
-}
 
-- on Windows 7
{-
C:\haskell>netproxy6
attaching runTcpClient
 
NEW runTcpServer session
START clientSrc serverSink
START serverSrc clientSink
END serverSrc clientSink
 
NEW runTcpServer session
START clientSrc serverSink
START serverSrc clientSink
END serverSrc clientSink
 
NEW runTcpServer session
START serverSrc clientSink
START clientSrc serverSink
END serverSrc clientSink
-}

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.