--- a/gameServer/HWProtoCore.hs Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/HWProtoCore.hs Wed Oct 05 22:39:07 2022 +0300
@@ -22,6 +22,7 @@
import Control.Monad.Reader
import Data.Maybe
import qualified Data.ByteString.Char8 as B
+import Text.Regex.TDFA
--------------------------------------
import CoreTypes
import HWProtoNEState
@@ -118,6 +119,8 @@
return [AnswerClients chans ["CHAT", nickGlobal, p]]
h "WATCH" f = return [QueryReplay f]
h "INFO" n | not $ B.null n = handleCmd ["INFO", n]
+ h "ALLOW_MSG" state = handleCmd ["ALLOW_MSG", state]
+ h "MSG" n = handleCmd ["MSG", n]
h "HELP" _ = handleCmd ["HELP"]
h "REGISTERED_ONLY" _ = serverAdminOnly $ do
rnc <- liftM snd ask
@@ -137,6 +140,56 @@
extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b)
+handleCmd_loggedin ["MSG", nickMsg] = do
+ thisCl <- thisClient
+ thisNick <- clientNick
+ clChans <- thisClientChans
+ let addEcho nick msg a = AnswerClients clChans ["CHAT", thisNick, B.concat ["/msg [", nick, "] ", msg]] : a
+ let sendingMsgAllowed clientInfo = case allowMsgState clientInfo of
+ AllowAll -> True
+ AllowRegistered -> isRegistered thisCl
+ AllowNone -> False
+ let sendNickMsg nick msg = do
+ (_, rnc) <- ask
+ maybeClientId <- clientByNick nick
+ case maybeClientId of
+ Just cl -> let ci = client rnc cl in
+ if sendingMsgAllowed ci then
+ return [AnswerClients [sendChan ci]
+ ["CHAT", thisNick, B.concat ["[direct] ", msg]]]
+ else
+ return [Warning $ loc "Player is not allowing direct messages."]
+ Nothing -> return [Warning $ loc "Player is not online."]
+
+ case nickMsg =~ ("^[[:space:]]*\\[([^]\\[]*)\\][[:space:]]*(.*)$" :: B.ByteString) of
+ [[_, "", msg]] -> return [Warning $ loc "Invalid /msg command."]
+ [[_, nick, msg]] -> addEcho (B.strip nick) msg <$> sendNickMsg (B.strip nick) msg
+ [] -> case nickMsg =~ ("^[[:space:]]*([^[:space:]]+)[[:space:]]*(.*)$" :: B.ByteString) of
+ [[_, nick, msg]] -> addEcho nick msg <$> sendNickMsg nick msg
+ [] -> return [Warning $ loc "Invalid /msg command."]
+
+
+handleCmd_loggedin ["ALLOW_MSG", state] = do
+ cl <- thisClient
+ let statusMsg state = B.pack $ "Direct messages allowed: " ++ stateToStr state
+ let changeIgnoreState newState = [
+ ModifyClient (\c -> c{allowMsgState = newState}),
+ AnswerClients [sendChan cl] ["CHAT", nickServer, loc $ statusMsg newState]]
+ let maybeNewState = stateFromStr state
+ return $ maybe
+ [Warning unknownCmdWarningText] changeIgnoreState maybeNewState
+ where
+ stateFromStr str = case B.strip str of
+ "all" -> Just AllowAll
+ "registered" -> Just AllowRegistered
+ "none" -> Just AllowNone
+ _ -> Nothing
+ stateToStr state = case state of
+ AllowAll -> "all"
+ AllowRegistered -> "registered"
+ AllowNone -> "none"
+
+
handleCmd_loggedin ["INFO", asknick] = do
(_, rnc) <- ask
maybeClientId <- clientByNick asknick