{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Concurrent (forkIO)
import Control.Concurrent.MVar
import Control.Monad (forever, liftM)
import Network (listenOn, withSocketsDo, PortID(..))
import Network.BSD (getProtocolNumber)
import Network.Socket (Family(..), SockAddr(..), SocketType(..), Socket(..), accept, connect, inet_addr, socket, sClose)
import Network.Socket.ByteString
import Data.ByteString.Char8 ()
import System.Environment (getArgs)
import System.IO (stdout, hFlush)
port = 8080
main = do
args <- getArgs
if length args < 1 || (head args /= "client" && head args /= "server")
then putStrLn "say client or server"
else withSocketsDo $ case head args of
"client" -> client
"server" -> server
client = do
putStrLn "Client mode"
tcp <- getProtocolNumber "tcp"
forever $ do sock <- socket AF_INET Stream tcp
localhost <- inet_addr "127.0.0.1"
putStr "Making a connection..."
connect sock (SockAddrInet port localhost)
send sock "a"
_ <- recv sock 1
sClose sock
putStrLn " done client connection"
server = do
putStrLn "Server mode"
sock <- listenOn (PortNumber port)
count <- newMVar 0
forever $ do count' <- modifyMVar count (\c -> return (c+1,c+1))
putStr $ (show count') ++ " About to accept..."
(conn, _saddr) <- accept sock
putStrLn " accepted."
hFlush stdout
forkIO $ handleServerConnection conn count'
handleServerConnection conn count = do
putStr $ (show count) ++ " Handling a server connection..."
rd <- recv conn 1
send conn "a"
sClose conn
putStrLn " done server connection."
hFlush stdout