|
1 module Main where |
|
2 |
|
3 import Network |
|
4 import IO |
|
5 import System.IO |
|
6 import Control.Concurrent |
|
7 import Control.Concurrent.STM |
|
8 import Control.Exception (finally) |
|
9 import Miscutils |
|
10 |
|
11 data ClientInfo = |
|
12 ClientInfo |
|
13 { |
|
14 handle :: Handle, |
|
15 nick :: String, |
|
16 game :: String, |
|
17 isMaster :: Bool |
|
18 } |
|
19 |
|
20 data RoomInfo = |
|
21 RoomInfo |
|
22 { |
|
23 name :: String, |
|
24 password :: String |
|
25 } |
|
26 |
|
27 |
|
28 handleCmd :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> (String, [String]) -> IO() |
|
29 handleCmd clientHandle clientsList roomsList ("SAY", param) = do |
|
30 ls <- atomically(readTVar clientsList) |
|
31 sendOthers (map (\x -> handle x) ls) clientHandle (concat param) |
|
32 return () |
|
33 |
|
34 handleCmd clientHandle clientsList roomsList ("CREATE", [roomname]) = do |
|
35 manipState roomsList (\x -> (RoomInfo roomname ""):x) |
|
36 manipState clientsList (\x -> map (\xc -> if (clientHandle == handle xc) then xc{isMaster = True, game = roomname} else xc) x) |
|
37 sendMsg clientHandle ("JOINED " ++ roomname) |
|
38 |
|
39 handleCmd clientHandle clientsList roomsList ("LIST", []) = do |
|
40 rl <- atomically $ readTVar roomsList |
|
41 sendMsg clientHandle (unlines $ map (\x -> name x) rl) |
|
42 |
|
43 handleCmd clientHandle _ _ ("PING", _) = sendMsg clientHandle "PONG" |
|
44 |
|
45 handleCmd clientHandle _ _ (_, _) = sendMsg clientHandle "Unknown cmd or bad syntax" |
|
46 |
|
47 |
|
48 clientLoop :: Handle -> TVar[ClientInfo] -> TVar[RoomInfo] -> IO() |
|
49 clientLoop clientHandle clientsList roomsList = do |
|
50 cline <- hGetLine clientHandle |
|
51 let (cmd, params) = extractCmd cline |
|
52 handleCmd clientHandle clientsList roomsList (cmd, params) |
|
53 if cmd /= "QUIT" then clientLoop clientHandle clientsList roomsList else return () |
|
54 |
|
55 |
|
56 main = do |
|
57 clientsList <- atomically $ newTVar[] |
|
58 roomsList <- atomically $ newTVar[] |
|
59 bracket |
|
60 (listenOn $ PortNumber 46631) |
|
61 (sClose) |
|
62 (loop clientsList roomsList) |
|
63 where |
|
64 loop clist rlist sock = accept sock >>= addClient clist rlist >> loop clist rlist sock |
|
65 |
|
66 addClient clist rlist (chandle, hostname, port) = do |
|
67 putStrLn $ "Client connected: " ++ show hostname |
|
68 hSetBuffering chandle LineBuffering |
|
69 manipState clist (\x -> (ClientInfo chandle "" "" False):x) -- add client to list |
|
70 forkIO $ finally |
|
71 (clientLoop chandle clist rlist) |
|
72 (do |
|
73 manipState clist (\x -> filter (\x -> chandle /= handle x) x) -- remove client from list |
|
74 hClose chandle) |