GHC network console interrupts test

Main.hs

module Main where

import Control.Concurrent (forkIO, threadDelay)
import Network.Socket
import Network.Socket.ByteString (recv)

main :: IO ()
main = do
    putStrLn "Starting server on port 9999..."
    addr <- head <$> getAddrInfo (Just defaultHints { addrSocketType = Stream }) (Just "127.0.0.1") (Just "9999")
    sock <- openSocket addr
    setSocketOption sock ReuseAddr 1
    bind sock (addrAddress addr)
    listen sock 1

    -- Fork a client that connects but never sends anything
    _ <- forkIO $ do
        threadDelay 100000  -- wait for server to call accept
        caddr <- head <$> getAddrInfo (Just defaultHints { addrSocketType = Stream }) (Just "127.0.0.1") (Just "9999")
        csock <- openSocket caddr
        connect csock (addrAddress caddr)
        putStrLn "Client connected (will stay silent)"
        -- Block forever so the connection stays open
        threadDelay maxBound

    putStrLn "Waiting for a connection..."
    (conn, peer) <- accept sock
    putStrLn $ "Accepted connection from " ++ show peer
    putStrLn "Blocking on recv... press Ctrl+C to test interruption"
    msg <- recv conn 1024
    putStrLn $ "Received: " ++ show msg

    close conn
    close sock