author  Wuzzy <Wuzzy2@mail.ru> 
Mon, 21 Jan 2019 19:28:39 +0100  
changeset 14648  be8af70adf2c 
parent 11466  4b5c7a5c49fd 
child 14841  111c4d750c6d 
permissions  rwrr 
10464
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

1 
{ 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

2 
* Hedgewars, a free turn based strategy game 
11046  3 
* Copyright (c) 20042015 Andrey Korotaev <unC0Rr@gmail.com> 
10464
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

4 
* 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

5 
* This program is free software; you can redistribute it and/or modify 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

6 
* it under the terms of the GNU General Public License as published by 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

7 
* the Free Software Foundation; version 2 of the License 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

8 
* 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

9 
* This program is distributed in the hope that it will be useful, 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

10 
* but WITHOUT ANY WARRANTY; without even the implied warranty of 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

11 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

12 
* GNU General Public License for more details. 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

13 
* 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

14 
* You should have received a copy of the GNU General Public License 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

15 
* along with this program; if not, write to the Free Software 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

16 
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 021101301 USA. 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

17 
\} 
d08611b52000
Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents:
10095
diff
changeset

18 

10095  19 
{# LANGUAGE OverloadedStrings, BangPatterns #} 
10090  20 
module FloodDetection where 
21 

10093  22 
import Control.Monad.State.Strict 
23 
import Data.Time 

24 
import Control.Arrow 

25 
 

26 
import ServerState 

10090  27 
import CoreTypes 
10095  28 
import Utils 
10090  29 

10093  30 
registerEvent :: Event > StateT ServerState IO [Action] 
31 
registerEvent e = do 

32 
eventInfo < client's $ einfo e 

10094  33 
if (null eventInfo)  0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo 
10095  34 

10093  35 
where 
36 
einfo LobbyChatMessage = eiLobbyChat 

37 
einfo EngineMessage = eiEM 

38 
einfo RoomJoin = eiJoin 

10094  39 

10093  40 
transformField LobbyChatMessage f = \c > c{eiLobbyChat = f $ eiLobbyChat c} 
10095  41 
transformField EngineMessage f = \c > c{eiEM = f $ eiEM c} 
42 
transformField RoomJoin f = \c > c{eiJoin = f $ eiJoin c} 

10094  43 

10095  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"] 

11466
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11046
diff
changeset

52 
em2 = [ByeClient $ loc "Excess flood"] 
10095  53 
join1 = [Warning $ loc "Warning! Joins flood protection activated"] 
54 
join2 = [ByeClient $ loc "Excess flood"] 

10094  55 

10093  56 
doCheck ei = do 
10094  57 
curTime < io getCurrentTime 
10095  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 

10094  63 

10095  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 
[] 

10094  71 

11466
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11046
diff
changeset

72 
return $ [ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei 
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11046
diff
changeset

73 
, ModifyClient (\c > c{pendingActions = actions})  append? prepend? just replacing for now 
4b5c7a5c49fd
Defer kicking to the time when everything is in consistent state
unc0rr
parents:
11046
diff
changeset

74 
] 
10094  75 

10093  76 
updateInfo = return [ 
10094  77 
ModifyClient $ transformField e 
78 
$ \(h:hs) > first (flip () 1) h : hs 

10093  79 
] 