persistent-ratelimit (empty) → 0.1.0.0

raw patch · 4 files changed

+187/−0 lines, 4 filesdep +basedep +timedep +yesodsetup-changed

Dependencies added: base, time, yesod

Files

• LICENSE +21/−0
• Setup.hs +2/−0
• persistent-ratelimit.cabal +74/−0
• src/Database/Persist/RateLimit.hs +90/−0

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2015 James Parker++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN+THE SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,74 @@+-- Initial persistent-ratelimit.cabal generated by cabal init.  For further+--  documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name:                persistent-ratelimit++-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             0.1.0.0++-- A short (one-line) description of the package.+synopsis:            A library for rate limiting activities with a persistent backend. ++-- A longer description of the package.+description:         This packages provides a library for rate limiting activities with a persistent backend. ++-- URL for the project homepage or repository.+homepage:            https://github.com/jprider63/persistent-ratelimit++-- The license under which the package is released.+license:             MIT++-- The file containing the license text.+license-file:        LICENSE++-- The package author(s).+author:              James Parker++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer:          dev@jamesparker.me++-- A copyright notice.+-- copyright:           ++category:            Database++build-type:          Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+-- extra-source-files:  ++-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.10+++library+  -- Modules exported by the library.+  exposed-modules:     Database.Persist.RateLimit+  +  -- Modules included in this library but not exported.+  -- other-modules:       +  +  -- LANGUAGE extensions used by modules in this package.+  other-extensions:    FunctionalDependencies+  +  -- Other library packages from which modules are imported.+  build-depends:       base >=4.6 && <4.8, time >=1.4 && <1.5, yesod >=1.4 && <1.5+  +  -- Directories containing source files.+  hs-source-dirs:      src+  +  -- Base language which the package is written in.+  default-language:    Haskell2010+  +source-repository head+  type:              git+  location:          git clone https://github.com/jprider63/persistent-ratelimit.git+

@@ -0,0 +1,90 @@+{-# LANGUAGE FunctionalDependencies, GADTs, FlexibleContexts #-}+module Database.Persist.RateLimit where++import Data.Time.Clock+import Prelude+import Yesod++class RateLimit action entity | action -> entity where+    -- | Number of actions allowed in the defined period. Period is easured in seconds. +    rateLimit :: action -> (Int, Int)++    -- | Convert a given action and time into an entity. +    convertAction :: action -> UTCTime -> entity++    -- | Return the field for the time constructor in the entity. +    timeConstructor :: action -> EntityField entity UTCTime++    -- | Filter to delete the records of a specific action. +    deleteFilters :: action -> [Filter entity]++    -- | Optionally add additional filters for database queries. +    -- The default is `[]`. +    -- You probably only need this if multiple rate limiters use the same entity. +    rateLimitFilters :: action -> [Filter entity]+    rateLimitFilters _ = []++-- | Returns the number of actions remaining for the current period. +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++-- | Determines whether an actions can be performed. +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)++-- | Record when an action occurs. +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++-- | Delete the recorded logs of an action. +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++-- | Periodically call this function to delete old actions that are past the rate limit period. +-- A nonsensical action can be used as only the rate limit period will be used. +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