equal
deleted
inserted
replaced
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
30 actions <- liftIO $ withRoomsAndClients rnc (\irnc -> runReader (handleCmd cmd) (ci, irnc)) |
31 forM_ (actions `deepseq` actions) processAction |
31 forM_ (actions `deepseq` actions) processAction |
32 |
32 |
33 mainLoop :: StateT ServerState IO () |
33 mainLoop :: StateT ServerState IO () |
34 mainLoop = forever $ do |
34 mainLoop = forever $ do |
35 get >>= \s -> put $! s |
35 -- get >>= \s -> put $! s |
36 |
36 |
37 si <- gets serverInfo |
37 si <- gets serverInfo |
38 r <- liftIO $ readChan $ coreChan si |
38 r <- liftIO $ readChan $ coreChan si |
39 |
39 |
40 case r of |
40 case r of |
50 reactCmd cmd |
50 reactCmd cmd |
51 |
51 |
52 Remove ci -> do |
52 Remove ci -> do |
53 liftIO $ debugM "Clients" $ "DeleteClient: " ++ show ci |
53 liftIO $ debugM "Clients" $ "DeleteClient: " ++ show ci |
54 processAction (DeleteClient ci) |
54 processAction (DeleteClient ci) |
55 |
|
56 --else |
|
57 --do |
|
58 --debugM "Clients" "Message from dead client" |
|
59 --return (serverInfo, rnc) |
|
60 |
55 |
61 ClientAccountInfo ci uid info -> do |
56 ClientAccountInfo ci uid info -> do |
62 rnc <- gets roomsClients |
57 rnc <- gets roomsClients |
63 exists <- liftIO $ clientExists rnc ci |
58 exists <- liftIO $ clientExists rnc ci |
64 when exists $ do |
59 when exists $ do |
88 |
83 |
89 startDBConnection si |
84 startDBConnection si |
90 |
85 |
91 rnc <- newRoomsAndClients newRoom |
86 rnc <- newRoomsAndClients newRoom |
92 |
87 |
93 _ <- forkIO $ evalStateT mainLoop (ServerState Nothing si Set.empty rnc) |
88 evalStateT mainLoop (ServerState Nothing si Set.empty rnc) |
94 |
|
95 forever $ threadDelay 3600000000 -- one hour |
|