gameServer/JoinsMonitor.hs
author unc0rr
Thu, 23 Jan 2014 01:04:17 +0400
changeset 10058 4ed428389c4e
parent 10005 800d1bd9021a
child 10090 a471a7bbc339
permissions -rw-r--r--
- Implement /callvote
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
e2ecde00b2a7 Oops, forgot 'hg add' this file
unc0rr
parents:
diff changeset
    39
    let pass = last30sec < 2 && last2min < 4 && last10min < 6
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