gameServer/JoinsMonitor.hs
author sheepluva
Sat, 31 May 2014 00:33:51 +0200
changeset 10249 b47ac2c19de3
parent 10090 a471a7bbc339
child 10460 8dcea9087d75
permissions -rw-r--r--
get rid of fpc warnings/hints
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     1
{-# LANGUAGE BangPatterns #-}
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     2
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     3
module JoinsMonitor(
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     4
    JoinsMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     5
    , newJoinMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     6
    , cleanup
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     7
    , joinsSentry
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     8
    ) where
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
     9
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    10
import qualified Data.Map as Map
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    11
import Data.Time
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    12
import Data.IORef
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    13
import qualified Data.ByteString as B
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    14
import Data.Maybe
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    15
import Control.Monad
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    16
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    17
newtype JoinsMonitor = JoinsMonitor (IORef (Map.Map B.ByteString [UTCTime]))
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    18
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    19
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    20
newJoinMonitor :: IO JoinsMonitor
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    21
newJoinMonitor = do
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    22
    ioref <- newIORef Map.empty
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    23
    return (JoinsMonitor ioref)
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    24
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    25
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    26
cleanup :: JoinsMonitor -> UTCTime -> IO ()
10005
800d1bd9021a fix build on travis
unC0Rr
parents: 9977
diff changeset
    27
cleanup (JoinsMonitor ref) time = modifyIORef ref f
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    28
    where
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    29
        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
    30
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    31
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    32
joinsSentry :: JoinsMonitor -> B.ByteString -> UTCTime -> IO Bool
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    33
joinsSentry (JoinsMonitor ref) host time = do
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    34
    m <- readIORef ref
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    35
    let lastJoins = map (diffUTCTime time) $ Map.findWithDefault [] host m
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    36
    let last30sec = length $ takeWhile (< 30) lastJoins
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    37
    let last2min = length $ takeWhile (< 120) lastJoins
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    38
    let last10min = length $ takeWhile (< 600) lastJoins
10090
a471a7bbc339 - Start work on flood detector
unc0rr
parents: 10005
diff changeset
    39
    let pass = last30sec < 2 && last2min < 3 && last10min < 5
9977
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    40
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    41
    when pass $ writeIORef ref $ Map.alter (Just . (:) time . fromMaybe []) host m
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    42
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    43
    return pass