wai-rate-limit-postgres 0.5.0.0 → 0.6.0.0
raw patch · 4 files changed
+114/−105 lines, 4 filesdep +bytestringdep +time-unitsdep −reludedep ~basedep ~resource-pooldep ~textPVP ok
version bump matches the API change (PVP)
Dependencies added: bytestring, time-units
Dependencies removed: relude
Dependency ranges changed: base, resource-pool, text, wai-rate-limit
API changes (from Hackage documentation)
- Network.Wai.RateLimit.Postgres: postgresBackend :: Pool Connection -> Text -> IO (Backend ByteString PGBackendError)
+ Network.Wai.RateLimit.Postgres: postgresBackend :: Pool Connection -> Text -> IO (Backend ByteString)
Files
- CHANGELOG.md +5/−0
- src/Network/Wai/RateLimit/Postgres.hs +34/−37
- test/Spec.hs +66/−58
- wai-rate-limit-postgres.cabal +9/−10
CHANGELOG.md view
@@ -3,6 +3,11 @@ `wai-rate-limit-postgres` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.6.0.0++* Update library to work with wai-rate-limit 0.3.0.0 - needs major bump as types are user visible types are changed.+* Now works work GHC 9.2+ ## 0.5.0.0 * Remove last remaining debug print statement
src/Network/Wai/RateLimit/Postgres.hs view
@@ -11,11 +11,15 @@ where import Control.Concurrent (forkIO, threadDelay)-import Control.Exception (Handler (..), catches, throwIO, try)+import Control.Exception (Exception, Handler (..), catches, throwIO, try)+import Control.Monad (forever, void)+import Data.ByteString (ByteString) import Data.Pool (Pool, withResource)+import Data.String (fromString)+import Data.Text (Text, unpack) import qualified Data.Text as T import qualified Database.PostgreSQL.Simple as PG-import Network.Wai.RateLimit.Backend (Backend (..))+import Network.Wai.RateLimit.Backend (Backend (..), BackendError (..)) -- | Represents reasons for why requests made to Postgres backend have failed. data PGBackendError@@ -35,13 +39,13 @@ initPostgresBackend p tableName = withResource p $ \c -> do res <- try $ PG.execute_ c createTableQuery either- (throwIO . PGBackendErrorInit)+ (throwIO . BackendError . PGBackendErrorInit) (const $ return ()) res where createTableQuery = fromString $- toString $+ unpack $ T.intercalate " " [ "CREATE TABLE IF NOT EXISTS",@@ -53,28 +57,25 @@ sqlHandlers :: [Handler a] sqlHandlers =- [ Handler (throwIO . PGBackendErrorBugFmt),- Handler (throwIO . PGBackendErrorBugQry),- Handler (throwIO . PGBackendErrorBugRes),- Handler (throwIO . PGBackendErrorBugSql)+ [ Handler (throwIO . BackendError . PGBackendErrorBugFmt),+ Handler (throwIO . BackendError . PGBackendErrorBugQry),+ Handler (throwIO . BackendError . PGBackendErrorBugRes),+ Handler (throwIO . BackendError . PGBackendErrorBugSql) ] -pgBackendGetUsage :: Pool PG.Connection -> Text -> ByteString -> IO (Either PGBackendError Integer)+pgBackendGetUsage :: Pool PG.Connection -> Text -> ByteString -> IO Integer pgBackendGetUsage p tableName key = withResource p $ \c -> do- res <-- try $- PG.query c getUsageQuery (PG.Only $ PG.Binary key) `catches` sqlHandlers- return $ do- rows <- res- case rows of- [] -> Right 0- [PG.Only a] -> Right a- _ -> Left PGBackendErrorAtMostOneRow+ rows <-+ PG.query c getUsageQuery (PG.Only $ PG.Binary key) `catches` sqlHandlers+ case rows of+ [] -> pure 0+ [PG.Only a] -> pure a+ _ -> throwIO $ BackendError PGBackendErrorAtMostOneRow where getUsageQuery = fromString $- toString $+ unpack $ T.intercalate " " [ "SELECT usage FROM",@@ -83,18 +84,16 @@ "AND expires_at > CURRENT_TIMESTAMP" ] -pgBackendIncAndGetUsage :: Pool PG.Connection -> Text -> ByteString -> Integer -> IO (Either PGBackendError Integer)+pgBackendIncAndGetUsage :: Pool PG.Connection -> Text -> ByteString -> Integer -> IO Integer pgBackendIncAndGetUsage p tableName key usage = withResource p $ \c -> do- res <- try $ PG.query c incAndGetQuery (PG.Binary key, usage) `catches` sqlHandlers- return $ do- rows <- res- case rows of- [PG.Only a] -> Right a- _ -> Left PGBackendErrorExactlyOneRow+ rows <- PG.query c incAndGetQuery (PG.Binary key, usage) `catches` sqlHandlers+ case rows of+ [PG.Only a] -> pure a+ _ -> throwIO $ BackendError PGBackendErrorExactlyOneRow where incAndGetQuery = fromString $- toString $+ unpack $ T.intercalate " " [ "INSERT INTO",@@ -107,18 +106,16 @@ "RETURNING usage" ] -pgBackendExpireIn :: Pool PG.Connection -> Text -> ByteString -> Integer -> IO (Either PGBackendError ())+pgBackendExpireIn :: Pool PG.Connection -> Text -> ByteString -> Integer -> IO () pgBackendExpireIn p tableName key seconds = withResource p $ \c -> do- res <- try $ PG.execute c expireInQuery (seconds, PG.Binary key) `catches` sqlHandlers- return $ do- count <- res- if count /= 1- then Left PGBackendErrorExactlyOneUpdate- else Right ()+ count <- PG.execute c expireInQuery (seconds, PG.Binary key) `catches` sqlHandlers+ if count /= 1+ then throwIO $ BackendError PGBackendErrorExactlyOneUpdate+ else pure () where expireInQuery = fromString $- toString $+ unpack $ T.intercalate " " [ "UPDATE",@@ -152,7 +149,7 @@ removeExpired = fromString $- toString $+ unpack $ T.intercalate " " [ "DELETE FROM",@@ -166,7 +163,7 @@ -- and table name to use for storage. The table will be created if it does not -- exist. A thread is also launched to periodically clean up expired rows from -- the table.-postgresBackend :: Pool PG.Connection -> Text -> IO (Backend ByteString PGBackendError)+postgresBackend :: Pool PG.Connection -> Text -> IO (Backend ByteString) postgresBackend p tableName = do initPostgresBackend p tableName pgBackendCleanup p tableName
test/Spec.hs view
@@ -7,7 +7,14 @@ threadDelay, ) import Control.Exception (bracket, throwIO)+import Control.Monad (replicateM, when)+import Data.ByteString (ByteString)+import Data.Either (isRight) import Data.Pool (Pool, createPool)+import Data.Text (Text)+import Data.Text.Encoding (decodeUtf8')+import Data.Text.Encoding.Error (UnicodeException)+import qualified Data.Time.Units as U import qualified Database.PostgreSQL.Simple as PG import Database.PostgreSQL.Simple.URL (parseDatabaseUrl) import Network.HTTP.Client (Manager, defaultManagerSettings, httpLbs, newManager, parseRequest, responseStatus)@@ -18,7 +25,6 @@ import Network.Wai.RateLimit.Postgres (postgresBackend) import qualified Network.Wai.RateLimit.Strategy as R import System.Environment.Blank (getEnv)-import System.IO.Error (userError) import Test.Tasty (defaultMain) import Test.Tasty.HUnit (assertFailure, testCaseSteps) @@ -44,7 +50,8 @@ pool <- mkConnPool pgBackend <- postgresBackend pool "rate_limiter_1" let app _ respond = respond $ Wai.responseLBS status200 [] "Ok!"- strategy = R.fixedWindow pgBackend seconds limit (const $ return key)+ s = U.fromMicroseconds $ 1_000_000 * seconds+ strategy = R.fixedWindow pgBackend s limit (const $ return key) middleware = R.rateLimiting strategy return $ middleware app @@ -62,64 +69,65 @@ main :: IO () main =- defaultMain $- testCaseSteps+ defaultMain+ $ testCaseSteps "Rate Limiting Tests"- $ \step ->- do- step "Limit excessive requests (1)"- bracket- (mkTestWaiApp 1 2 "key1" >>= launchApp)- tearDownApp- $ \_ -> do- mgr <- newManager defaultManagerSettings- rs <- replicateM 3 $ mkReq mgr- when (rs /= [200, 200, 429]) $ do- assertFailure "Not ratelimited!"+ $ \step ->+ do+ step "Limit excessive requests (1)"+ bracket+ (mkTestWaiApp 1 2 "key1" >>= launchApp)+ tearDownApp+ $ \_ -> do+ mgr <- newManager defaultManagerSettings+ rs <- replicateM 3 $ mkReq mgr+ when (rs /= [200, 200, 429]) $ do+ assertFailure "Not ratelimited!" - step "Limit excessive requests (2)"- bracket- (mkTestWaiApp 1 3 "key2" >>= launchApp)- tearDownApp- $ \_ -> do- mgr <- newManager defaultManagerSettings- rs <- replicateM 10 $ mkReq mgr- when (rs /= replicate 3 200 ++ replicate 7 429) $- assertFailure "Unexpected result!"+ step "Limit excessive requests (2)"+ bracket+ (mkTestWaiApp 1 3 "key2" >>= launchApp)+ tearDownApp+ $ \_ -> do+ mgr <- newManager defaultManagerSettings+ rs <- replicateM 10 $ mkReq mgr+ when (rs /= replicate 3 200 ++ replicate 7 429) $+ assertFailure "Unexpected result!" - step "Allow non-excessive requests"- bracket- (mkTestWaiApp 1 3 "key3" >>= launchApp)- tearDownApp- $ \_ -> do- mgr <- newManager defaultManagerSettings- rs <- replicateM 3 $ mkReq mgr- when (rs /= [200, 200, 200]) $- assertFailure "Unexpected result!"+ step "Allow non-excessive requests"+ bracket+ (mkTestWaiApp 1 3 "key3" >>= launchApp)+ tearDownApp+ $ \_ -> do+ mgr <- newManager defaultManagerSettings+ rs <- replicateM 3 $ mkReq mgr+ when (rs /= [200, 200, 200]) $+ assertFailure "Unexpected result!" - step "Allow excessive requests, slow down and then be allowed"- bracket- (mkTestWaiApp 1 1 "key4" >>= launchApp)- tearDownApp- $ \_ -> do- mgr <- newManager defaultManagerSettings- rs <- replicateM 3 $ mkReq mgr- when (rs /= [200, 429, 429]) $- assertFailure "Unexpected result!"- threadDelay 1_000_000- rs2 <- replicateM 1 $ mkReq mgr- when (rs2 /= [200]) $- assertFailure "Unexpected result!"+ step "Allow excessive requests, slow down and then be allowed"+ bracket+ (mkTestWaiApp 1 1 "key4" >>= launchApp)+ tearDownApp+ $ \_ -> do+ mgr <- newManager defaultManagerSettings+ rs <- replicateM 3 $ mkReq mgr+ when (rs /= [200, 429, 429]) $+ assertFailure "Unexpected result!"+ threadDelay 1_000_000+ rs2 <- replicateM 1 $ mkReq mgr+ when (rs2 /= [200]) $+ assertFailure "Unexpected result!" - step "Allow keys that are invalid as unicode strings"- let invalidUtf8String = "\187" :: ByteString- when (isRight (decodeUtf8Strict invalidUtf8String :: Either UnicodeException Text)) $- assertFailure "`invalidUtf8String` appears to have a valid UTF8 string"- bracket- (mkTestWaiApp 1 3 invalidUtf8String >>= launchApp)- tearDownApp- $ \_ -> do- mgr <- newManager defaultManagerSettings- rs <- replicateM 3 $ mkReq mgr- when (rs /= [200, 200, 200]) $- assertFailure $ "Unexpected result: " ++ show rs+ step "Allow keys that are invalid as unicode strings"+ let invalidUtf8String = "\187" :: ByteString+ when (isRight (decodeUtf8' invalidUtf8String :: Either UnicodeException Text)) $+ assertFailure "`invalidUtf8String` appears to have a valid UTF8 string"+ bracket+ (mkTestWaiApp 1 3 invalidUtf8String >>= launchApp)+ tearDownApp+ $ \_ -> do+ mgr <- newManager defaultManagerSettings+ rs <- replicateM 3 $ mkReq mgr+ when (rs /= [200, 200, 200]) $+ assertFailure $+ "Unexpected result: " ++ show rs
wai-rate-limit-postgres.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: wai-rate-limit-postgres-version: 0.5.0.0+version: 0.6.0.0 category: Security, Web, Network synopsis: See README for more info description:@@ -17,21 +17,19 @@ CHANGELOG.md tested-with: GHC == 8.10.7 GHC == 9.0.2+ GHC == 9.2.3 source-repository head type: git location: https://github.com/donatello/wai-rate-limit-postgres.git common common-options- build-depends: base >= 4.12 && < 5- , relude ^>= 1.0- , wai-rate-limit ^>= 0.1.0.0+ build-depends: base >= 4.14 && < 5+ , bytestring >= 0.10 && < 0.12+ , wai-rate-limit >= 0.3.0.0 && < 1.0 , postgresql-simple ^>= 0.6- , text ^>= 1.2.4- , resource-pool ^>= 0.2.3.2-- mixins: base hiding (Prelude)- , relude (Relude as Prelude)+ , text >= 1.2.4 && < 2.1+ , resource-pool >= 0.2.3.2 && < 0.4 ghc-options: -Wall -Wcompat@@ -72,9 +70,10 @@ main-is: Spec.hs build-depends: wai-rate-limit-postgres , postgresql-simple-url- , resource-pool+ , resource-pool < 0.3 , tasty , tasty-hunit+ , time-units , http-client , http-types , warp