{- |
Module      :  Network.IRC.Bot.Limiter
Description :  simple rate limiter
Copyright   :  (c) 2012 Eric Mertens
License     :  BSD3

Maintainer  :  jeremy@seereason.com
Stability   :  stable
Portability :  portable

A simple rate limiter.
-}
module Network.IRC.Bot.Limiter
    ( Limiter(..)
    , newLimiter
    , limit
    )
    where

import Control.Concurrent      (ThreadId, forkIO, threadDelay)
import           Control.Concurrent.SSem (SSem)
import qualified Control.Concurrent.SSem as SSem
import Control.Monad           (forever)

data Limiter = Limiter
    { Limiter -> SSem
limitsIn       :: SSem
    , Limiter -> SSem
limitsOut      :: SSem
    , Limiter -> Int
limitsDelay    :: Int
    , Limiter -> ThreadId
limitsThreadId :: ThreadId
    }

-- | Construct a new rate limit control
newLimiter :: Int -- ^ max burst length
           -> Int -- ^ delay (in microseconds)
           -> IO Limiter
newLimiter :: Int -> Int -> IO Limiter
newLimiter Int
burst Int
delay = do
  SSem
rdy  <- Int -> IO SSem
SSem.new Int
burst
  SSem
sent <- Int -> IO SSem
SSem.new Int
0
  let l :: Limiter
l = Limiter :: SSem -> SSem -> Int -> ThreadId -> Limiter
Limiter { limitsIn :: SSem
limitsIn       = SSem
sent
                  , limitsOut :: SSem
limitsOut      = SSem
rdy
                  , limitsDelay :: Int
limitsDelay    = Int
delay
                  , limitsThreadId :: ThreadId
limitsThreadId = [Char] -> ThreadId
forall a. HasCallStack => [Char] -> a
error [Char]
"limiter thread not started yet"
                  }
  ThreadId
tid <- IO () -> IO ThreadId
forkIO (Limiter -> IO ()
forall b. Limiter -> IO b
limiter Limiter
l)
  Limiter -> IO Limiter
forall (m :: * -> *) a. Monad m => a -> m a
return (Limiter -> IO Limiter) -> Limiter -> IO Limiter
forall a b. (a -> b) -> a -> b
$ Limiter
l { limitsThreadId :: ThreadId
limitsThreadId = ThreadId
tid }

-- | Execute this before sending
limit :: Limiter -> IO ()
limit :: Limiter -> IO ()
limit Limiter
l = do
  SSem -> IO ()
SSem.wait   (Limiter -> SSem
limitsOut Limiter
l)
  SSem -> IO ()
SSem.signal (Limiter -> SSem
limitsIn Limiter
l)

-- | Loop which manages the limit timers
limiter :: Limiter -> IO b
limiter :: Limiter -> IO b
limiter Limiter
l = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
  SSem -> IO ()
SSem.wait    (Limiter -> SSem
limitsIn Limiter
l)
  Int -> IO ()
threadDelay  (Limiter -> Int
limitsDelay Limiter
l)
  SSem -> IO ()
SSem.signal  (Limiter -> SSem
limitsOut Limiter
l)