packages feed

network-light-0.1.0.6: tests/unittests/concurrent-clients/Server.hs

module Server where

import System.Environment
import System.IO
import System.Network

port :: Int
port = 9932

serve :: Socket -> IO ()
serve sfd = do
    (cfd, _) <- accept sfd
    msg <- recvString cfd 1024
    putStrLn ("SERVER_GOT:" ++ msg)
    hFlush stdout
    sendString cfd ("ack:" ++ msg)
    close cfd

main :: IO ()
main = do
    [nStr] <- getArgs
    let n = read nStr :: Int

    sfd <- socket AF_INET SOCK_STREAM
    setsocketopt sfd SO_REUSEADDR 1
    bind sfd (mkSockAddr port Nothing)
    listen sfd n

    putStrLn "READY"
    hFlush stdout

    -- Clients connect concurrently (the OS queues them in the listen
    -- backlog); the server itself just drains that backlog one at a
    -- time, which is enough to prove several clients can be in flight
    -- against the same listening socket at once.
    mapM_ (const (serve sfd)) [1 .. n]

    close sfd
    putStrLn "SERVER_DONE"
    hFlush stdout