20 module HWProtoCore where |
20 module HWProtoCore where |
21 |
21 |
22 import Control.Monad.Reader |
22 import Control.Monad.Reader |
23 import Data.Maybe |
23 import Data.Maybe |
24 import qualified Data.ByteString.Char8 as B |
24 import qualified Data.ByteString.Char8 as B |
|
25 import Text.Regex.TDFA |
25 -------------------------------------- |
26 -------------------------------------- |
26 import CoreTypes |
27 import CoreTypes |
27 import HWProtoNEState |
28 import HWProtoNEState |
28 import HWProtoLobbyState |
29 import HWProtoLobbyState |
29 import HWProtoInRoomState |
30 import HWProtoInRoomState |
116 rnc <- liftM snd ask |
117 rnc <- liftM snd ask |
117 let chans = map (sendChan . client rnc) $ allClients rnc |
118 let chans = map (sendChan . client rnc) $ allClients rnc |
118 return [AnswerClients chans ["CHAT", nickGlobal, p]] |
119 return [AnswerClients chans ["CHAT", nickGlobal, p]] |
119 h "WATCH" f = return [QueryReplay f] |
120 h "WATCH" f = return [QueryReplay f] |
120 h "INFO" n | not $ B.null n = handleCmd ["INFO", n] |
121 h "INFO" n | not $ B.null n = handleCmd ["INFO", n] |
|
122 h "ALLOW_MSG" state = handleCmd ["ALLOW_MSG", state] |
|
123 h "MSG" n = handleCmd ["MSG", n] |
121 h "HELP" _ = handleCmd ["HELP"] |
124 h "HELP" _ = handleCmd ["HELP"] |
122 h "REGISTERED_ONLY" _ = serverAdminOnly $ do |
125 h "REGISTERED_ONLY" _ = serverAdminOnly $ do |
123 rnc <- liftM snd ask |
126 rnc <- liftM snd ask |
124 let chans = map (sendChan . client rnc) $ allClients rnc |
127 let chans = map (sendChan . client rnc) $ allClients rnc |
125 return |
128 return |
134 ] |
137 ] |
135 h _ _ = return [Warning unknownCmdWarningText] |
138 h _ _ = return [Warning unknownCmdWarningText] |
136 |
139 |
137 |
140 |
138 extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b) |
141 extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b) |
|
142 |
|
143 handleCmd_loggedin ["MSG", nickMsg] = do |
|
144 thisCl <- thisClient |
|
145 thisNick <- clientNick |
|
146 clChans <- thisClientChans |
|
147 let addEcho nick msg a = AnswerClients clChans ["CHAT", thisNick, B.concat ["/msg [", nick, "] ", msg]] : a |
|
148 let sendingMsgAllowed clientInfo = case allowMsgState clientInfo of |
|
149 AllowAll -> True |
|
150 AllowRegistered -> isRegistered thisCl |
|
151 AllowNone -> False |
|
152 let sendNickMsg nick msg = do |
|
153 (_, rnc) <- ask |
|
154 maybeClientId <- clientByNick nick |
|
155 case maybeClientId of |
|
156 Just cl -> let ci = client rnc cl in |
|
157 if sendingMsgAllowed ci then |
|
158 return [AnswerClients [sendChan ci] |
|
159 ["CHAT", thisNick, B.concat ["[direct] ", msg]]] |
|
160 else |
|
161 return [Warning $ loc "Player is not allowing direct messages."] |
|
162 Nothing -> return [Warning $ loc "Player is not online."] |
|
163 |
|
164 case nickMsg =~ ("^[[:space:]]*\\[([^]\\[]*)\\][[:space:]]*(.*)$" :: B.ByteString) of |
|
165 [[_, "", msg]] -> return [Warning $ loc "Invalid /msg command."] |
|
166 [[_, nick, msg]] -> addEcho (B.strip nick) msg <$> sendNickMsg (B.strip nick) msg |
|
167 [] -> case nickMsg =~ ("^[[:space:]]*([^[:space:]]+)[[:space:]]*(.*)$" :: B.ByteString) of |
|
168 [[_, nick, msg]] -> addEcho nick msg <$> sendNickMsg nick msg |
|
169 [] -> return [Warning $ loc "Invalid /msg command."] |
|
170 |
|
171 |
|
172 handleCmd_loggedin ["ALLOW_MSG", state] = do |
|
173 cl <- thisClient |
|
174 let statusMsg state = B.pack $ "Direct messages allowed: " ++ stateToStr state |
|
175 let changeIgnoreState newState = [ |
|
176 ModifyClient (\c -> c{allowMsgState = newState}), |
|
177 AnswerClients [sendChan cl] ["CHAT", nickServer, loc $ statusMsg newState]] |
|
178 let maybeNewState = stateFromStr state |
|
179 return $ maybe |
|
180 [Warning unknownCmdWarningText] changeIgnoreState maybeNewState |
|
181 where |
|
182 stateFromStr str = case B.strip str of |
|
183 "all" -> Just AllowAll |
|
184 "registered" -> Just AllowRegistered |
|
185 "none" -> Just AllowNone |
|
186 _ -> Nothing |
|
187 stateToStr state = case state of |
|
188 AllowAll -> "all" |
|
189 AllowRegistered -> "registered" |
|
190 AllowNone -> "none" |
|
191 |
139 |
192 |
140 handleCmd_loggedin ["INFO", asknick] = do |
193 handleCmd_loggedin ["INFO", asknick] = do |
141 (_, rnc) <- ask |
194 (_, rnc) <- ask |
142 maybeClientId <- clientByNick asknick |
195 maybeClientId <- clientByNick asknick |
143 isAdminAsking <- liftM isAdministrator thisClient |
196 isAdminAsking <- liftM isAdministrator thisClient |