--- a/gameServer/CoreTypes.hs Fri Jan 31 16:51:20 2014 +0400
+++ b/gameServer/CoreTypes.hs Fri Jan 31 23:36:02 2014 +0400
@@ -84,8 +84,8 @@
data Event = LobbyChatMessage
| EngineMessage
| RoomJoin
-
-type EventsInfo = [(Int, Maybe UTCTime)]
+
+type EventsInfo = [(Int, UTCTime)]
newEventsInfo :: EventsInfo
newEventsInfo = []
--- a/gameServer/FloodDetection.hs Fri Jan 31 16:51:20 2014 +0400
+++ b/gameServer/FloodDetection.hs Fri Jan 31 23:36:02 2014 +0400
@@ -10,23 +10,33 @@
registerEvent :: Event -> StateT ServerState IO [Action]
registerEvent e = do
eventInfo <- client's $ einfo e
- if (not $ null eventInfo) && 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo
+ 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{eiLobbyChat = f $ eiEM c}
transformField RoomJoin f = \c -> c{eiLobbyChat = f $ eiJoin c}
-
+
+ boundaries :: Event -> (Int, (NominalDiffTime, Int, [Action]), (NominalDiffTime, Int, [Action]))
+ boundaries LobbyChatMessage = (3, (10, 2, []), (30, 3, []))
+ boundaries EngineMessage = (10, (10, 3, []), (30, 4, undefined))
+ boundaries RoomJoin = (2, (10, 2, []), (35, 3, []))
+
doCheck ei = do
- liftM Just $ io getCurrentTime
- return []
+ curTime <- io getCurrentTime
+ let (numPerEntry, (sec1, num1, ac1), (sec2, num2, ac2)) = boundaries e
+
+ let nei2 = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei
+ let nei1 = takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei1
+
+ let actions = if length nei2 >= num2 then ac2 else if length nei1 >= num1 then ac1 else []
+
+ return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei2) : actions
+
updateInfo = return [
- ModifyClient $ transformField e
- $ \ei -> if null ei then
- []
- else
- let (h:hs) = ei in first (flip (-) 1) h : hs
+ ModifyClient $ transformField e
+ $ \(h:hs) -> first (flip (-) 1) h : hs
]