Simple TCP Client

Question

I'm trying to implement simple TCP Client in Haskell. But it gets closed as soon as it connects. I don't know what is causing it to close. How could I make it so that it would print lines from server into stdout and send lines from stdin to server forever until stdin receives line ":quit"?

import Control.Monad (forever)
import Network (withSocketsDo, PortID(..), connectTo)
import System.IO
import Control.Concurrent (forkFinally)
import Control.Concurrent.Async (race)

main :: IO ()
main = withSocketsDo $ do
  -- connect to my local tcp server
  handle <- connectTo "192.168.137.1" (PortNumber 44444)
  -- should close the connection using handle after everything is done
  _ <- forkFinally (talk handle) (\_ -> hClose handle)
  return ()

talk :: Handle -> IO ()
talk handle = do
    hSetNewlineMode handle universalNewlineMode
    hSetBuffering handle LineBuffering
    -- if either one of them terminates, other one will get terminated
    _ <- race (interactWithServer handle) (interactWithUser handle)
    return ()

interactWithServer :: Handle -> IO ()
interactWithServer handle = forever $ do
  line <- hGetLine handle
  print line          -- print a line that came from server into stdout

interactWithUser :: Handle -> IO ()
interactWithUser handle = do
  line <- getLine
  case line of
    ":quit" -> return ()            -- stop loop if user input is :quit
    _ -> do hPutStrLn handle line
            interactWithUser handle -- send, then continue looping

Poona

In GHC, the whole program quits once the main thread does, even if there are other threads still running. – Brabazon

Answer 1

With Ørjan Johansen's help I figured it out. forkFinally was creating a thread then after that main thread was getting closed. That line was meant to wait until talk finished and then close the connection. It had to be (also shortened it)

main :: IO ()
main = withSocketsDo $ do
  handle <- connectTo "192.168.137.1" (PortNumber 44444)
  talk handle `finally` hClose handle

talk :: Handle -> IO ()
talk handle = do
    hSetNewlineMode handle universalNewlineMode
    hSetBuffering handle LineBuffering
    _ <- race fromServer toServer
    return ()
  where
    fromServer = forever $ do
      line <- hGetLine handle
      print line
    toServer = do
      line <- getLine
      case line of
-- server accepts /quit as disconnect command so better send it to the server 
        ":quit" -> do hPutStrLn handle "/quit"; return "Quit"
        _ ->  do hPutStrLn handle line; toServer

I hope this code is safe :D

Poona