|
1 {-# LANGUAGE OverloadedStrings, BangPatterns #-} |
1 module FloodDetection where |
2 module FloodDetection where |
2 |
3 |
3 import Control.Monad.State.Strict |
4 import Control.Monad.State.Strict |
4 import Data.Time |
5 import Data.Time |
5 import Control.Arrow |
6 import Control.Arrow |
6 ---------------- |
7 ---------------- |
7 import ServerState |
8 import ServerState |
8 import CoreTypes |
9 import CoreTypes |
|
10 import Utils |
9 |
11 |
10 registerEvent :: Event -> StateT ServerState IO [Action] |
12 registerEvent :: Event -> StateT ServerState IO [Action] |
11 registerEvent e = do |
13 registerEvent e = do |
12 eventInfo <- client's $ einfo e |
14 eventInfo <- client's $ einfo e |
13 if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
15 if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo |
|
16 |
14 where |
17 where |
15 einfo LobbyChatMessage = eiLobbyChat |
18 einfo LobbyChatMessage = eiLobbyChat |
16 einfo EngineMessage = eiEM |
19 einfo EngineMessage = eiEM |
17 einfo RoomJoin = eiJoin |
20 einfo RoomJoin = eiJoin |
18 |
21 |
19 transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
22 transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c} |
20 transformField EngineMessage f = \c -> c{eiLobbyChat = f $ eiEM c} |
23 transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c} |
21 transformField RoomJoin f = \c -> c{eiLobbyChat = f $ eiJoin c} |
24 transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c} |
22 |
25 |
23 boundaries :: Event -> (Int, (NominalDiffTime, Int, [Action]), (NominalDiffTime, Int, [Action])) |
26 boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action])) |
24 boundaries LobbyChatMessage = (3, (10, 2, []), (30, 3, [])) |
27 boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2)) |
25 boundaries EngineMessage = (10, (10, 3, []), (30, 4, undefined)) |
28 boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2)) |
26 boundaries RoomJoin = (2, (10, 2, []), (35, 3, [])) |
29 boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2)) |
|
30 |
|
31 chat1 = [Warning $ loc "Warning! Chat flood protection activated"] |
|
32 chat2 = [ByeClient $ loc "Excess flood"] |
|
33 em1 = [Warning $ loc "Game messages flood detected - 1"] |
|
34 em2 = [Warning $ loc "Game messages flood detected - 2"] |
|
35 join1 = [Warning $ loc "Warning! Joins flood protection activated"] |
|
36 join2 = [ByeClient $ loc "Excess flood"] |
27 |
37 |
28 doCheck ei = do |
38 doCheck ei = do |
29 curTime <- io getCurrentTime |
39 curTime <- io getCurrentTime |
30 let (numPerEntry, (sec1, num1, ac1), (sec2, num2, ac2)) = boundaries e |
40 let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e |
31 |
41 |
32 let nei2 = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei |
42 let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei |
33 let nei1 = takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei1 |
43 let l2 = length nei |
|
44 let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei |
34 |
45 |
35 let actions = if length nei2 >= num2 then ac2 else if length nei1 >= num1 then ac1 else [] |
46 let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then |
|
47 ac2 |
|
48 else |
|
49 if l1 >= num1 || l2 >= num2 then |
|
50 ac1 |
|
51 else |
|
52 [] |
36 |
53 |
37 return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei2) : actions |
54 return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions |
38 |
55 |
39 updateInfo = return [ |
56 updateInfo = return [ |
40 ModifyClient $ transformField e |
57 ModifyClient $ transformField e |
41 $ \(h:hs) -> first (flip (-) 1) h : hs |
58 $ \(h:hs) -> first (flip (-) 1) h : hs |
42 ] |
59 ] |