{-
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2014 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 \-}

{-# LANGUAGE BangPatterns #-}

module JoinsMonitor(
    JoinsMonitor
    , newJoinMonitor
    , cleanup
    , joinsSentry
    ) where

import qualified Data.Map as Map
import Data.Time
import Data.IORef
import qualified Data.ByteString as B
import Data.Maybe
import Control.Monad

newtype JoinsMonitor = JoinsMonitor (IORef (Map.Map B.ByteString [UTCTime]))


newJoinMonitor :: IO JoinsMonitor
newJoinMonitor = do
    ioref <- newIORef Map.empty
    return (JoinsMonitor ioref)


cleanup :: JoinsMonitor -> UTCTime -> IO ()
cleanup (JoinsMonitor ref) time = modifyIORef ref f
    where
        f = Map.mapMaybe (\v -> let v' = takeWhile (\t -> diffUTCTime time t < 60*60) v in if null v' then Nothing else Just v')


joinsSentry :: JoinsMonitor -> B.ByteString -> UTCTime -> IO Bool
joinsSentry (JoinsMonitor ref) host time = do
    m <- readIORef ref
    let lastJoins = map (diffUTCTime time) $ Map.findWithDefault [] host m
    let last30sec = length $ takeWhile (< 30) lastJoins
    let last2min = length $ takeWhile (< 120) lastJoins
    let last10min = length $ takeWhile (< 600) lastJoins
    let pass = last30sec < 2 && last2min < 3 && last10min < 5

    when pass $ writeIORef ref $ Map.alter (Just . (:) time . fromMaybe []) host m

    return pass