1 {-

     2  * Hedgewars, a free turn based strategy game

     3  * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>

     4  *

     5  * This program is free software; you can redistribute it and/or modify

     6  * it under the terms of the GNU General Public License as published by

     7  * the Free Software Foundation; version 2 of the License

     8  *

     9  * This program is distributed in the hope that it will be useful,

    10  * but WITHOUT ANY WARRANTY; without even the implied warranty of

    11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

    12  * GNU General Public License for more details.

    13  *

    14  * You should have received a copy of the GNU General Public License

    15  * along with this program; if not, write to the Free Software

    16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

    17  \-}

    18 

    19 {-# LANGUAGE OverloadedStrings, BangPatterns #-}

    20 module FloodDetection where

    21 

    22 import Control.Monad.State.Strict

    23 import Data.Time

    24 import Control.Arrow

    25 ----------------

    26 import ServerState

    27 import CoreTypes

    28 import Utils

    29 

    30 registerEvent :: Event -> StateT ServerState IO [Action]

    31 registerEvent e = do

    32     eventInfo <- client's $ einfo e

    33     if (null eventInfo) || 0 == (fst $ head eventInfo) then doCheck eventInfo else updateInfo

    34 

    35     where

    36     einfo LobbyChatMessage = eiLobbyChat

    37     einfo EngineMessage = eiEM

    38     einfo RoomJoin = eiJoin

    39 

    40     transformField LobbyChatMessage f = \c -> c{eiLobbyChat = f $ eiLobbyChat c}

    41     transformField EngineMessage f = \c -> c{eiEM = f $ eiEM c}

    42     transformField RoomJoin f = \c -> c{eiJoin = f $ eiJoin c}

    43 

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

    52     em2 = [Warning $ loc "Game messages flood detected - 2"]

    53     join1 = [Warning $ loc "Warning! Joins flood protection activated"]

    54     join2 = [ByeClient $ loc "Excess flood"]

    55 

    56     doCheck ei = do

    57         curTime <- io getCurrentTime

    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

    63 

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

    71 

    72         return $ (ModifyClient . transformField e . const $ (numPerEntry, curTime) : nei) : actions

    73 

    74     updateInfo = return [

    75         ModifyClient $ transformField e

    76             $ \(h:hs) -> first (flip (-) 1) h : hs

    77         ]