equal
deleted
inserted
replaced
39 |
39 |
40 case r of |
40 case r of |
41 Accept ci -> processAction (AddClient ci) |
41 Accept ci -> processAction (AddClient ci) |
42 |
42 |
43 ClientMessage (ci, cmd) -> do |
43 ClientMessage (ci, cmd) -> do |
44 liftIO $ debugM "Clients" $ (show ci) ++ ": " ++ (show cmd) |
44 liftIO $ debugM "Clients" $ show ci ++ ": " ++ show cmd |
45 |
45 |
46 removed <- gets removedClients |
46 removed <- gets removedClients |
47 when (not $ ci `Set.member` removed) $ do |
47 unless (ci `Set.member` removed) $ do |
48 as <- get |
48 as <- get |
49 put $! as{clientIndex = Just ci} |
49 put $! as{clientIndex = Just ci} |
50 reactCmd cmd |
50 reactCmd cmd |
51 |
51 |
52 Remove ci -> do |
52 Remove ci -> do |
59 --return (serverInfo, rnc) |
59 --return (serverInfo, rnc) |
60 |
60 |
61 ClientAccountInfo ci uid info -> do |
61 ClientAccountInfo ci uid info -> do |
62 rnc <- gets roomsClients |
62 rnc <- gets roomsClients |
63 exists <- liftIO $ clientExists rnc ci |
63 exists <- liftIO $ clientExists rnc ci |
64 when (exists) $ do |
64 when exists $ do |
65 as <- get |
65 as <- get |
66 put $! as{clientIndex = Just ci} |
66 put $! as{clientIndex = Just ci} |
67 uid' <- client's clUID |
67 uid' <- client's clUID |
68 when (uid == (hashUnique uid')) $ processAction (ProcessAccountInfo info) |
68 when (uid == hashUnique uid') $ processAction (ProcessAccountInfo info) |
69 return () |
69 return () |
70 |
70 |
71 TimerAction tick -> |
71 TimerAction tick -> |
72 mapM_ processAction $ |
72 mapM_ processAction $ |
73 PingAll : [StatsAction | even tick] |
73 PingAll : [StatsAction | even tick] |
75 |
75 |
76 startServer :: ServerInfo -> Socket -> IO () |
76 startServer :: ServerInfo -> Socket -> IO () |
77 startServer si serverSocket = do |
77 startServer si serverSocket = do |
78 putStrLn $ "Listening on port " ++ show (listenPort si) |
78 putStrLn $ "Listening on port " ++ show (listenPort si) |
79 |
79 |
80 forkIO $ |
80 _ <- forkIO $ |
81 acceptLoop |
81 acceptLoop |
82 serverSocket |
82 serverSocket |
83 (coreChan si) |
83 (coreChan si) |
84 |
84 |
85 return () |
85 return () |
86 |
86 |
87 forkIO $ timerLoop 0 $ coreChan si |
87 _ <- forkIO $ timerLoop 0 $ coreChan si |
88 |
88 |
89 startDBConnection si |
89 startDBConnection si |
90 |
90 |
91 rnc <- newRoomsAndClients newRoom |
91 rnc <- newRoomsAndClients newRoom |
92 |
92 |
93 forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc) |
93 _ <- forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc) |
94 |
94 |
95 forever $ threadDelay 3600000000 -- one hour |
95 forever $ threadDelay 3600000000 -- one hour |