# HG changeset patch
# User S.D.
# Date 1664998747 -10800
# Node ID bf92592915c65d335d32c8cfcf01187d7be012b6
# Parent  f185e7367dd3d58ef7e18439bd1917152f6d17aa
Add direct message server command (/msg <nick_name>|<[nick name]> <message>)

diff -r f185e7367dd3 -r bf92592915c6 gameServer/CMakeLists.txt
--- a/gameServer/CMakeLists.txt	Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CMakeLists.txt	Wed Oct 05 22:39:07 2022 +0300
@@ -42,6 +42,7 @@
     HandlerUtils.hs
     JoinsMonitor.hs
     NetRoutines.hs
+    CommandHelp.hs
     Opts.hs
     RoomsAndClients.hs
     ServerCore.hs
diff -r f185e7367dd3 -r bf92592915c6 gameServer/CommandHelp.hs
--- a/gameServer/CommandHelp.hs	Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CommandHelp.hs	Wed Oct 05 22:39:07 2022 +0300
@@ -33,6 +33,8 @@
     loc "/me <message>: Chat action, e.g. '/me eats pizza' becomes '* Player eats pizza'",
     loc "/rnd: Flip a virtual coin and reply with 'heads' or 'tails'",
     loc "/rnd [A] [B] [C] [...]: Reply with a random word from the given list",
+    loc "/msg <nick_without_spaces> <message> | /msg <[nick with spaces]> <message>: Send a direct message to the player",
+    loc "/allow_msg <all|registered|none>: Specify what kind of players are allowed to /msg you",
 #if defined(OFFICIAL_SERVER)
     loc "/watch <id>: Watch a demo stored on the server with the given ID",
 #endif
diff -r f185e7367dd3 -r bf92592915c6 gameServer/CoreTypes.hs
--- a/gameServer/CoreTypes.hs	Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CoreTypes.hs	Wed Oct 05 22:39:07 2022 +0300
@@ -127,6 +127,8 @@
         details :: Maybe GameDetails
     }
 
+data AllowMsgState = AllowAll | AllowRegistered | AllowNone
+
 data ClientInfo =
     ClientInfo
     {
@@ -152,6 +154,7 @@
         isKickedFromServer :: !Bool,
         isJoinedMidGame :: !Bool,
         hasAskedList :: !Bool,
+        allowMsgState :: !AllowMsgState,
         clientClan :: !(Maybe B.ByteString),
         checkInfo :: !(Maybe CheckInfo),
         eiLobbyChat,
diff -r f185e7367dd3 -r bf92592915c6 gameServer/HWProtoCore.hs
--- 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
diff -r f185e7367dd3 -r bf92592915c6 gameServer/NetRoutines.hs
--- a/gameServer/NetRoutines.hs	Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/NetRoutines.hs	Wed Oct 05 22:39:07 2022 +0300
@@ -71,6 +71,7 @@
                     False
                     False
                     False
+                    AllowAll
                     Nothing
                     Nothing
                     newEventsInfo