Ticket #3937: ListenOn.hs

module Main where

import Network
import Network.Socket
import System.IO
import Control.Concurrent
import Control.Exception
import Network.BSD

listenOn2 :: Int -> IO Socket
listenOn2 port = do
    proto <- getProtocolNumber "tcp"
    bracketOnError
        (socket AF_INET Stream proto)
        (sClose)
        (\sock -> do
            setSocketOption sock ReuseAddr 1
            bindSocket sock (SockAddrInet (fromIntegral port) iNADDR_ANY)
            listen sock maxListenQueue
            return sock
        )

httpServer = do
    socket <- listenOn2 (8999)
    putStrLn "Accepting connections..."
    (handle,_,_) <- Network.accept socket
    putStrLn "Got a connection"
    hClose handle
    sClose socket

main = withSocketsDo $ do
    putStrLn "Started"
    httpTid <- forkIO $ httpServer
    -- let it start
    threadDelay 1000000
    putStrLn "About to kill server thread..."
    killThread httpTid
    putStrLn "Server thread killed"