|
10090
|
1 |
module FloodDetection where
|
|
|
2 |
|
|
10093
|
3 |
import Control.Monad.State.Strict
|
|
|
4 |
import Data.Time
|
|
|
5 |
import Control.Arrow
|
|
|
6 |
----------------
|
|
|
7 |
import ServerState
|
|
10090
|
8 |
import CoreTypes
|
|
|
9 |
|
|
10093
|
10 |
registerEvent :: Event -> StateT ServerState IO [Action]
|
|
|
11 |
registerEvent e = do
|
|
|
12 |
eventInfo <- client's $ einfo e
|
|
10094
|
13 |
if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo
|
|
10093
|
14 |
where
|
|
|
15 |
einfo LobbyChatMessage = eiLobbyChat
|
|
|
16 |
einfo EngineMessage = eiEM
|
|
|
17 |
einfo RoomJoin = eiJoin
|
|
10094
|
18 |
|
|
10093
|
19 |
transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c}
|
|
|
20 |
transformField EngineMessage f = \c -> c{eiLobbyChat = f $ eiEM c}
|
|
|
21 |
transformField RoomJoin f = \c -> c{eiLobbyChat = f $ eiJoin c}
|
|
10094
|
22 |
|
|
|
23 |
boundaries :: Event -> (Int, (NominalDiffTime, Int, [Action]), (NominalDiffTime, Int, [Action]))
|
|
|
24 |
boundaries LobbyChatMessage = (3, (10, 2, []), (30, 3, []))
|
|
|
25 |
boundaries EngineMessage = (10, (10, 3, []), (30, 4, undefined))
|
|
|
26 |
boundaries RoomJoin = (2, (10, 2, []), (35, 3, []))
|
|
|
27 |
|
|
10093
|
28 |
doCheck ei = do
|
|
10094
|
29 |
curTime <- io getCurrentTime
|
|
|
30 |
let (numPerEntry, (sec1, num1, ac1), (sec2, num2, ac2)) = boundaries e
|
|
|
31 |
|
|
|
32 |
let nei2 = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei
|
|
|
33 |
let nei1 = takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei1
|
|
|
34 |
|
|
|
35 |
let actions = if length nei2 >= num2 then ac2 else if length nei1 >= num1 then ac1 else []
|
|
|
36 |
|
|
|
37 |
return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei2) : actions
|
|
|
38 |
|
|
10093
|
39 |
updateInfo = return [
|
|
10094
|
40 |
ModifyClient $ transformField e
|
|
|
41 |
$ \(h:hs) -> first (flip (-) 1) h : hs
|
|
10093
|
42 |
]
|