gameServer/Actions.hs
branchqmlfrontend
changeset 11481 caa1e84c3ac2
parent 11465 0ae2e4c13bd1
child 11575 db7743e2fad1
equal deleted inserted replaced
11480:b0c34402038c 11481:caa1e84c3ac2
   464     io $ writeChan dbq ClearCache
   464     io $ writeChan dbq ClearCache
   465     return ()
   465     return ()
   466 
   466 
   467 
   467 
   468 processAction (ProcessAccountInfo info) = do
   468 processAction (ProcessAccountInfo info) = do
       
   469     si <- gets serverInfo
   469     case info of
   470     case info of
   470         HasAccount passwd isAdmin isContr -> do
   471         HasAccount passwd isAdmin isContr -> do
   471             b <- isBanned
   472             b <- isBanned
   472             c <- client's isChecker
   473             c <- client's isChecker
   473             when (not b) $ (if c then checkerLogin else playerLogin) passwd isAdmin isContr
   474             when (not b) $ (if c then checkerLogin else playerLogin) passwd isAdmin isContr
   474         Guest -> do
   475         Guest | isRegisteredUsersOnly si -> do
       
   476             processAction $ ByeClient "Registered users only"
       
   477             | otherwise -> do
   475             b <- isBanned
   478             b <- isBanned
   476             c <- client's isChecker
   479             c <- client's isChecker
   477             when (not b) $
   480             when (not b) $
   478                 if c then
   481                 if c then
   479                     checkerLogin "" False False
   482                     checkerLogin "" False False
   506 
   509 
   507 processAction JoinLobby = do
   510 processAction JoinLobby = do
   508     chan <- client's sendChan
   511     chan <- client's sendChan
   509     rnc <- gets roomsClients
   512     rnc <- gets roomsClients
   510     clientNick <- client's nick
   513     clientNick <- client's nick
       
   514     clProto <- client's clientProto
   511     isAuthenticated <- liftM (not . B.null) $ client's webPassword
   515     isAuthenticated <- liftM (not . B.null) $ client's webPassword
   512     isAdmin <- client's isAdministrator
   516     isAdmin <- client's isAdministrator
   513     isContr <- client's isContributor
   517     isContr <- client's isContributor
   514     loggedInClients <- liftM (Prelude.filter isVisible) $! allClientsS
   518     loggedInClients <- liftM (Prelude.filter isVisible) $! allClientsS
   515     let (lobbyNicks, clientsChans) = unzip . L.map (nick &&& sendChan) $ loggedInClients
   519     let (lobbyNicks, clientsChans) = unzip . L.map (nick &&& sendChan) $ loggedInClients
   519     inRoomNicks <- io $
   523     inRoomNicks <- io $
   520         allClientsM rnc
   524         allClientsM rnc
   521         >>= filterM (liftM ((/=) lobbyId) . clientRoomM rnc)
   525         >>= filterM (liftM ((/=) lobbyId) . clientRoomM rnc)
   522         >>= mapM (client'sM rnc nick)
   526         >>= mapM (client'sM rnc nick)
   523     let clFlags = B.concat . L.concat $ [["u" | isAuthenticated], ["a" | isAdmin], ["c" | isContr]]
   527     let clFlags = B.concat . L.concat $ [["u" | isAuthenticated], ["a" | isAdmin], ["c" | isContr]]
       
   528 
       
   529     roomsInfoList <- io $ do
       
   530         rooms <- roomsM rnc
       
   531         mapM (\r -> (if isNothing $ masterID r then return "" else client'sM rnc nick (fromJust $ masterID r))
       
   532             >>= \cn -> return $ roomInfo clProto cn r)
       
   533             $ filter (\r -> (roomProto r == clProto)) rooms
       
   534 
   524     mapM_ processAction . concat $ [
   535     mapM_ processAction . concat $ [
   525         [AnswerClients clientsChans ["LOBBY:JOINED", clientNick]]
   536         [AnswerClients clientsChans ["LOBBY:JOINED", clientNick]]
   526         , [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)]
   537         , [AnswerClients [chan] ("LOBBY:JOINED" : clientNick : lobbyNicks)]
   527         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+u" : authenticatedNicks) | not $ null authenticatedNicks]
   538         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+u" : authenticatedNicks) | not $ null authenticatedNicks]
   528         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+a" : adminsNicks) | not $ null adminsNicks]
   539         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+a" : adminsNicks) | not $ null adminsNicks]
   529         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+c" : contrNicks) | not $ null contrNicks]
   540         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+c" : contrNicks) | not $ null contrNicks]
   530         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+i" : inRoomNicks) | not $ null inRoomNicks]
   541         , [AnswerClients [chan] ("CLIENT_FLAGS" : "+i" : inRoomNicks) | not $ null inRoomNicks]
   531         , [AnswerClients (chan : clientsChans) ["CLIENT_FLAGS",  B.concat["+" , clFlags], clientNick] | not $ B.null clFlags]
   542         , [AnswerClients (chan : clientsChans) ["CLIENT_FLAGS",  B.concat["+" , clFlags], clientNick] | not $ B.null clFlags]
   532         , [ModifyClient (\cl -> cl{logonPassed = True, isVisible = True})]
   543         , [ModifyClient (\cl -> cl{logonPassed = True, isVisible = True})]
   533         , [SendServerMessage]
   544         , [SendServerMessage]
       
   545         , [AnswerClients [chan] ("ROOMS" : concat roomsInfoList)]
   534         ]
   546         ]
   535 
   547 
   536 
   548 
   537 processAction (KickClient kickId) = do
   549 processAction (KickClient kickId) = do
   538     modify (\s -> s{clientIndex = Just kickId})
   550     modify (\s -> s{clientIndex = Just kickId})