module Database.Persist.RateLimit where
import Data.Time.Clock
import Prelude
import Yesod
class RateLimit action entity | action -> entity where
rateLimit :: action -> (Int, Int)
convertAction :: action -> UTCTime -> entity
timeConstructor :: action -> EntityField entity UTCTime
deleteFilters :: action -> [Filter entity]
rateLimitFilters :: action -> [Filter entity]
rateLimitFilters _ = []
numberOfRemainingActions :: (RateLimit action entity,
PersistEntityBackend entity ~ YesodPersistBackend site,
YesodPersist site,
PersistEntity entity,
PersistQuery (YesodPersistBackend site)) =>
action -> HandlerT site IO Int
numberOfRemainingActions action = do
let ( limit, period) = rateLimit action
let timeConstr = timeConstructor action
let filters = rateLimitFilters action
now <- lift getCurrentTime
let timeBound = addUTCTime (fromIntegral $ negate period) now
c <- runDB $ count $ (timeConstr >. timeBound):filters
return $ limit c
canPerformAction :: (RateLimit action entity,
PersistEntityBackend entity ~ YesodPersistBackend site,
YesodPersist site,
PersistEntity entity,
PersistQuery (YesodPersistBackend site)) =>
action -> HandlerT site IO Bool
canPerformAction action =
numberOfRemainingActions action >>= return . (> 0)
recordAction :: (RateLimit action entity,
PersistEntityBackend entity ~ YesodPersistBackend site,
YesodPersist site,
PersistEntity entity,
PersistQuery (YesodPersistBackend site)) =>
action -> HandlerT site IO ()
recordAction action = do
now <- lift getCurrentTime
let entity = convertAction action now
runDB $ insert_ entity
deleteRecordedAction :: (RateLimit action entity,
PersistEntityBackend entity ~ YesodPersistBackend site,
YesodPersist site,
PersistEntity entity,
PersistQuery (YesodPersistBackend site)) =>
action -> HandlerT site IO ()
deleteRecordedAction action =
let filters = deleteFilters action in
runDB $ deleteWhere filters
cleanOldActions :: (RateLimit action entity,
PersistEntityBackend entity ~ YesodPersistBackend site,
YesodPersist site,
PersistEntity entity,
PersistQuery (YesodPersistBackend site)) =>
action -> HandlerT site IO ()
cleanOldActions action = do
let ( _, period) = rateLimit action
let timeConstr = timeConstructor action
let filters = rateLimitFilters action
now <- lift getCurrentTime
let timeBound = addUTCTime (fromIntegral $ negate period) now
runDB $ deleteWhere filters