gameServer/FloodDetection.hs
branchsdl2transition
changeset 11362 ed5a6478e710
parent 11046 47a8c19ecb60
child 11466 4b5c7a5c49fd
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gameServer/FloodDetection.hs	Tue Nov 10 20:43:13 2015 +0100
@@ -0,0 +1,77 @@
+{-
+ * Hedgewars, a free turn based strategy game
+ * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; version 2 of the License
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ \-}
+
+{-# LANGUAGE OverloadedStrings, BangPatterns #-}
+module FloodDetection where
+
+import Control.Monad.State.Strict
+import Data.Time
+import Control.Arrow
+----------------
+import ServerState
+import CoreTypes
+import Utils
+
+registerEvent :: Event -> StateT ServerState IO [Action]
+registerEvent e = do
+    eventInfo <- client's $ einfo e
+    if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo
+
+    where
+    einfo LobbyChatMessage = eiLobbyChat
+    einfo EngineMessage = eiEM
+    einfo RoomJoin = eiJoin
+
+    transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c}
+    transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c}
+    transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c}
+
+    boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action]))
+    boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2))
+    boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2))
+    boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2))
+
+    chat1 = [Warning $ loc "Warning! Chat flood protection activated"]
+    chat2 = [ByeClient $ loc "Excess flood"]
+    em1 = [Warning $ loc "Game messages flood detected - 1"]
+    em2 = [Warning $ loc "Game messages flood detected - 2"]
+    join1 = [Warning $ loc "Warning! Joins flood protection activated"]
+    join2 = [ByeClient $ loc "Excess flood"]
+
+    doCheck ei = do
+        curTime <- io getCurrentTime
+        let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e
+
+        let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei
+        let l2 = length nei
+        let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei
+
+        let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then 
+                ac2
+                else
+                if l1 >= num1 || l2 >= num2 then 
+                    ac1
+                    else
+                    []
+
+        return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions
+
+    updateInfo = return [
+        ModifyClient $ transformField e
+            $ \(h:hs) -> first (flip (-) 1) h : hs
+        ]