gameServer/JoinsMonitor.hs
author Wuzzy <Wuzzy2@mail.ru>
Mon, 13 Nov 2017 22:14:45 +0100
changeset 12841 8610462e3d33
parent 11046 47a8c19ecb60
permissions -rw-r--r--
Remove 2 unused number tags in Construction Mode GUI These numbers are shown aside the power tag, but the numbers never change. They don't serve any purpose and are just visual clutter and annoying, since they partially overlap. They are probably a leftover from copying code over from other scripts. With this changeset, only the power and turn time are left visible, as it is supposed to.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     1
{-
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     2
 * Hedgewars, a free turn based strategy game
11046
47a8c19ecb60 more copyright fixes
sheepluva
parents: 10460
diff changeset
     3
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
10460
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     4
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     5
 * This program is free software; you can redistribute it and/or modify
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     6
 * it under the terms of the GNU General Public License as published by
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     7
 * the Free Software Foundation; version 2 of the License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     8
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
     9
 * This program is distributed in the hope that it will be useful,
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    10
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    11
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    12
 * GNU General Public License for more details.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    13
 *
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    14
 * You should have received a copy of the GNU General Public License
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    15
 * along with this program; if not, write to the Free Software
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    16
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    17
 \-}
8dcea9087d75 Added copyrights to gameServer directory
Gianfranco Costamagna <costamagnagianfranco@yahoo.it>
parents: 10090
diff changeset
    18
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    19
{-# LANGUAGE BangPatterns #-}
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    20
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    21
module JoinsMonitor(
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    22
    JoinsMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    23
    , newJoinMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    24
    , cleanup
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    25
    , joinsSentry
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    26
    ) where
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    27
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    28
import qualified Data.Map as Map
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    29
import Data.Time
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    30
import Data.IORef
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    31
import qualified Data.ByteString as B
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    32
import Data.Maybe
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    33
import Control.Monad
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    34
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    35
newtype JoinsMonitor = JoinsMonitor (IORef (Map.Map B.ByteString [UTCTime]))
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    36
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    37
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    38
newJoinMonitor :: IO JoinsMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    39
newJoinMonitor = do
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    40
    ioref <- newIORef Map.empty
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    41
    return (JoinsMonitor ioref)
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    42
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    43
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    44
cleanup :: JoinsMonitor -> UTCTime -> IO ()
10005
800d1bd9021a fix build on travis
unC0Rr
parents: 9977
diff changeset
    45
cleanup (JoinsMonitor ref) time = modifyIORef ref f
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    46
    where
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    47
        f = Map.mapMaybe (\v -> let v' = takeWhile (\t -> diffUTCTime time t < 60*60) v in if null v' then Nothing else Just v')
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    48
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    49
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    50
joinsSentry :: JoinsMonitor -> B.ByteString -> UTCTime -> IO Bool
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    51
joinsSentry (JoinsMonitor ref) host time = do
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    52
    m <- readIORef ref
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    53
    let lastJoins = map (diffUTCTime time) $ Map.findWithDefault [] host m
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    54
    let last30sec = length $ takeWhile (< 30) lastJoins
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    55
    let last2min = length $ takeWhile (< 120) lastJoins
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    56
    let last10min = length $ takeWhile (< 600) lastJoins
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents: 10005
diff changeset
    57
    let pass = last30sec < 2 && last2min < 3 && last10min < 5
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    58
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    59
    when pass $ writeIORef ref $ Map.alter (Just . (:) time . fromMaybe []) host m
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    60
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    61
    return pass