Haskell network connection graceful handler

Question

Just trying to work out some simple graceful connection handling code in Haskell to get my head around some of the IO/Networking/Threading stuff, some tips where I'm doing things poorly would be appreciated! I'm sure I could just use a module like network pipes that would handle all the graceful stuff for me out of the box, but this was just an exercise to try and understand basic network/multithreaded IO handling in haskell.

import Network
import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import System.IO
type Connection = (Handle, HostName, PortNumber)
type ConnectionHandler = Connection -> IO ()
type Pool = [(ThreadId, Connection)]
main = runConn
fst' (a,b,c) = a
connFromPool (a,(b,c,d)) = b
runConn = withSocketsDo $ do
 s <- (listenOn (PortNumber 1234))
 p <- atomically (newTVar ([]::Pool))
 t <- forkIO (repeatAccept s p)
 repeatUntilExit stdin stdout putChar ""
 p' <- atomically $ readTVar p
 mapM_ killThread (t:map fst p')
 sClose s
 putStrLn "Enter to exit." >> getLine
repeatAccept s p = do
 c <- accept s
 t <- forkFinally (echoHandler c) (exitPool p)
 atomically $ do
 p' <- readTVar p
 writeTVar p ((t,c):p')
 repeatAccept s p
exitPool :: TVar Pool -> a -> IO ()
exitPool pool = \_ -> do
 tid <- myThreadId
 print $ "Exiting: " ++ (show tid)
 p <- (atomically $ readTVar pool)
 h <- hdl p tid
 open <- hIsOpen h
 if open then do hPutStrLn h "bye\n" >> hFlush h >> hClose h else return ()
 atomically $ do
 pool' <- readTVar pool
 writeTVar pool $ filter ((/=tid).fst) pool'
 return ()
 where hdl p tid = return.connFromPool $ head $ filter ((==tid).fst) p
echoHandler :: ConnectionHandler
echoHandler a@(hdl,_,_) = repeatUntilExit hdl hdl echoToHandleAndStdout ""
 where echoToHandleAndStdout x = hPutChar hdl x >> putChar x
repeatUntilExit :: Handle -> Handle -> (Char -> IO ()) -> [Char] -> IO ()
repeatUntilExit hIn hOut f "exit\n" = return ()
repeatUntilExit hIn hOut f x = do
 c <- hGetChar hIn
 f c
 repeatUntilExit hIn hOut f (appendToLastFive c)
 where appendToLastFive a = (reverse . (:)a . take 4 . reverse) x
-- this is just here because I'm using an older version of base which doesn't have it yet
forkFinally :: IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally action and_then =
 mask $ \restore ->
 forkIO $ try (restore action) >>= and_then

Answer 1

Just one remark: When handling IO resources, I'd strongly suggest using bracket for resources that are obtained at some point and later released. Not only it makes your code much safer, it clearly demarcates which resource is used in which parts. And that also prevents separating opening and closing of resources, which is often a hard-to-find error.