|
1 {- |
|
2 * Hedgewars, a free turn based strategy game |
|
3 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 * |
|
5 * This program is free software; you can redistribute it and/or modify |
|
6 * it under the terms of the GNU General Public License as published by |
|
7 * the Free Software Foundation; version 2 of the License |
|
8 * |
|
9 * This program is distributed in the hope that it will be useful, |
|
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
12 * GNU General Public License for more details. |
|
13 * |
|
14 * You should have received a copy of the GNU General Public License |
|
15 * along with this program; if not, write to the Free Software |
|
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. |
|
17 \-} |
|
18 |
|
19 {-# LANGUAGE OverloadedStrings, BangPatterns #-} |
|
20 module FloodDetection where |
|
21 |
|
22 import Control.Monad.State.Strict |
|
23 import Data.Time |
|
24 import Control.Arrow |
|
25 ---------------- |
|
26 import ServerState |
|
27 import CoreTypes |
|
28 import Utils |
|
29 |
|
30 registerEvent :: Event -> StateT ServerState IO [Action] |
|
31 registerEvent e = do |
|
32 eventInfo <- client's $ einfo e |
|
33 if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
|
34 |
|
35 where |
|
36 einfo LobbyChatMessage = eiLobbyChat |
|
37 einfo EngineMessage = eiEM |
|
38 einfo RoomJoin = eiJoin |
|
39 |
|
40 transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
|
41 transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c} |
|
42 transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c} |
|
43 |
|
44 boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action])) |
|
45 boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2)) |
|
46 boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2)) |
|
47 boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2)) |
|
48 |
|
49 chat1 = [Warning $ loc "Warning! Chat flood protection activated"] |
|
50 chat2 = [ByeClient $ loc "Excess flood"] |
|
51 em1 = [Warning $ loc "Game messages flood detected - 1"] |
|
52 em2 = [Warning $ loc "Game messages flood detected - 2"] |
|
53 join1 = [Warning $ loc "Warning! Joins flood protection activated"] |
|
54 join2 = [ByeClient $ loc "Excess flood"] |
|
55 |
|
56 doCheck ei = do |
|
57 curTime <- io getCurrentTime |
|
58 let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e |
|
59 |
|
60 let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei |
|
61 let l2 = length nei |
|
62 let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei |
|
63 |
|
64 let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then |
|
65 ac2 |
|
66 else |
|
67 if l1 >= num1 || l2 >= num2 then |
|
68 ac1 |
|
69 else |
|
70 [] |
|
71 |
|
72 return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions |
|
73 |
|
74 updateInfo = return [ |
|
75 ModifyClient $ transformField e |
|
76 $ \(h:hs) -> first (flip (-) 1) h : hs |
|
77 ] |