gameServer/FloodDetection.hs
author nemo
Mon, 11 May 2015 13:53:08 -0400
changeset 10942 5d7dd938dedc
parent 10464 d08611b52000
child 11046 47a8c19ecb60
permissions -rw-r--r--
This probably fixes bug #839 - mine time was hardcoded to 3000 in Attack, instead of using the "0 as undefined" input that other places were using. When re653e96b0ec3 started paying attention to the input parameter, this previously ignored value became a problem.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
d08611b52000 Added two copyrights on gameServer
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10095
diff changeset
     3
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
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 02110-1301 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
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    19
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    20
module FloodDetection where
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    21
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    22
import Control.Monad.State.Strict
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    23
import Data.Time
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    24
import Control.Arrow
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    25
----------------
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    26
import ServerState
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    27
import CoreTypes
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    28
import Utils
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents:
diff changeset
    29
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    30
registerEvent :: Event -> StateT ServerState IO [Action]
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    31
registerEvent e = do
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    32
    eventInfo <- client's $ einfo e
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    33
    if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    34
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    35
    where
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    36
    einfo LobbyChatMessage = eiLobbyChat
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    37
    einfo EngineMessage = eiEM
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    38
    einfo RoomJoin = eiJoin
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    39
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    40
    transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c}
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    41
    transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c}
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    42
    transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c}
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    43
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    44
    boundaries :: Event -> (Int, (NominalDiffTime, Int), (NominalDiffTime, Int), ([Action], [Action]))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    45
    boundaries LobbyChatMessage = (3, (10, 2), (30, 3), (chat1, chat2))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    46
    boundaries EngineMessage = (8, (10, 4), (25, 5), (em1, em2))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    47
    boundaries RoomJoin = (2, (10, 2), (35, 3), (join1, join2))
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    48
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    49
    chat1 = [Warning $ loc "Warning! Chat flood protection activated"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    50
    chat2 = [ByeClient $ loc "Excess flood"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    51
    em1 = [Warning $ loc "Game messages flood detected - 1"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    52
    em2 = [Warning $ loc "Game messages flood detected - 2"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    53
    join1 = [Warning $ loc "Warning! Joins flood protection activated"]
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    54
    join2 = [ByeClient $ loc "Excess flood"]
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    55
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    56
    doCheck ei = do
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    57
        curTime <- io getCurrentTime
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    58
        let (numPerEntry, (sec1, num1), (sec2, num2), (ac1, ac2)) = boundaries e
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    59
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    60
        let nei = takeWhile ((>=) sec2 . diffUTCTime curTime . snd) ei
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    61
        let l2 = length nei
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    62
        let l1 = length $ takeWhile ((>=) sec1 . diffUTCTime curTime . snd) nei
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    63
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    64
        let actions = if l2 >= num2 + 1 || l1 >= num1 + 1 then 
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    65
                ac2
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    66
                else
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    67
                if l1 >= num1 || l2 >= num2 then 
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    68
                    ac1
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    69
                    else
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    70
                    []
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    71
10095
003fc694c0c3 Actually do some actions when flood detected
unc0rr
parents: 10094
diff changeset
    72
        return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    73
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    74
    updateInfo = return [
10094
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    75
        ModifyClient $ transformField e
d3a2fe9f04f2 Define some boundaries to detect events
unc0rr
parents: 10093
diff changeset
    76
            $ \(h:hs) -> first (flip (-) 1) h : hs
10093
ada172d33988 More work on flood detector
unc0rr
parents: 10090
diff changeset
    77
        ]