From f136c127f6f37d8e74a4453e28091bc8398d4a60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 8 Oct 2019 16:06:28 +0200 Subject: [PATCH 1/5] Issue #13: adds a rate limit unit to counter keys --- README.md | 17 +++++++++++------ lib/Fencer/AppState.hs | 10 ++++++++++ lib/Fencer/Counter.hs | 1 + lib/Fencer/Main.hs | 4 ++++ lib/Fencer/Server.hs | 10 +++++----- 5 files changed, 31 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index a922a34..c10ac10 100644 --- a/README.md +++ b/README.md @@ -186,12 +186,17 @@ you shouldn’t have made this request because you are over the limit". ### Rate limiting models -There are two models for rate limiting – the "bucket" one and the "rolling -window" one. In the bucket model you have a single counter which is as -granular as the rate-limiting unit – say, if the limit is "N requests per -hour" then the counter will get incremented for all requests for -X:00:00–X:59:59. If you have spent your limit at the beginning of the hour, -you don't get any credit until the next hour starts and the counter resets. +There are two models for rate limiting – the "bucket" one and the +"rolling window" one. In the bucket model you have a single counter +which is as granular as the rate-limiting unit – say, if the limit is +"N requests per hour" then the counter will get incremented for all +requests for X:00:00–X:59:59. If you have spent your limit at the +beginning of the hour, you don't get any credit until the next hour +starts and the counter resets. Every counter is indexed by a time unit +so that if there is an update in the configuration and rules are +reloaded as a result, a change in time limit yields a new reset +counter; if there is an update in the request rate only, an existing +counter is updated. The "rolling window" model is more interesting. In this model, you are limited based on how many requests you’ve made in the past hour, which diff --git a/lib/Fencer/AppState.hs b/lib/Fencer/AppState.hs index 06d8238..5d57219 100644 --- a/lib/Fencer/AppState.hs +++ b/lib/Fencer/AppState.hs @@ -154,6 +154,16 @@ getLimit appState domain descriptor = Just ruleTree -> pure (applyRules descriptor ruleTree) -- | Set 'appStateRules' and 'appStateRulesLoaded'. +-- +-- The 'appStateCounters' field stays unchanged. This is in accordance +-- with the behavior of @lyft/ratelimit@. +-- +-- There might be a change in rulsets with the same descriptors that +-- updates the value of 'requests_per_unit' (with the time unit left +-- intact), which allows a different number of requests to be +-- made. This is as expected. However, if there is a change in the +-- rate limit time unit, a new counter will be created, regardless of +-- how many requests the previous counter had used up. setRules :: AppState -> [(DomainId, RuleTree)] -> STM () setRules appState rules = do writeTVar (appStateRulesLoaded appState) True diff --git a/lib/Fencer/Counter.hs b/lib/Fencer/Counter.hs index 3c4a8dc..e1f911b 100644 --- a/lib/Fencer/Counter.hs +++ b/lib/Fencer/Counter.hs @@ -24,6 +24,7 @@ import Fencer.Time data CounterKey = CounterKey { counterKeyDomain :: !DomainId , counterKeyDescriptor :: ![(RuleKey, RuleValue)] + , counterKeyUnit :: !TimeUnit } deriving stock (Eq, Generic) deriving anyclass (Hashable) diff --git a/lib/Fencer/Main.hs b/lib/Fencer/Main.hs index 253e6f8..6a737c6 100644 --- a/lib/Fencer/Main.hs +++ b/lib/Fencer/Main.hs @@ -89,7 +89,11 @@ reloadRules logger settings appState = do show (map (unDomainId . domainDefinitionId) ruleDefinitions)) -- Recreate 'appStateRules' + -- + -- There is no need to remove old rate limiting rules atomically $ + -- See the documentation of 'setRules' for details on what + -- happens with counters during rule reloading. setRules appState [ ( domainDefinitionId rule , definitionsToRuleTree (NE.toList . domainDefinitionDescriptors $ rule)) diff --git a/lib/Fencer/Server.hs b/lib/Fencer/Server.hs index 9078213..c8ce565 100644 --- a/lib/Fencer/Server.hs +++ b/lib/Fencer/Server.hs @@ -136,13 +136,13 @@ shouldRateLimitDescriptor appState (arg #hits -> hits) domain descriptor = getLimit appState domain descriptor >>= \case Nothing -> pure Nothing Just limit -> do + let counterKey :: CounterKey + counterKey = CounterKey + { counterKeyDomain = domain + , counterKeyDescriptor = descriptor + , counterKeyUnit = rateLimitUnit limit } status <- recordHits appState (#hits hits) (#limit limit) counterKey pure (Just (limit, status)) - where - counterKey :: CounterKey - counterKey = CounterKey - { counterKeyDomain = domain - , counterKeyDescriptor = descriptor } ---------------------------------------------------------------------------- -- Working with protobuf structures From b61cb084f4dc922026e15c6dc53f0a88e7a5baf3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Fri, 11 Oct 2019 15:50:18 +0200 Subject: [PATCH 2/5] Issue #13: introduces a test for rule counters --- fencer.cabal | 1 + lib/Fencer/AppState.hs | 8 ++- lib/Fencer/Counter.hs | 2 +- test/Fencer/Rules/Test.hs | 123 +++++++++++++++++++++++++++++++++++-- test/Fencer/Server/Test.hs | 14 ++++- 5 files changed, 138 insertions(+), 10 deletions(-) diff --git a/fencer.cabal b/fencer.cabal index b870c9f..27ab41b 100644 --- a/fencer.cabal +++ b/fencer.cabal @@ -126,6 +126,7 @@ test-suite test-fencer , neat-interpolation , proto3-wire , proto3-suite + , stm-containers , tasty , tasty-discover , tasty-hunit diff --git a/lib/Fencer/AppState.hs b/lib/Fencer/AppState.hs index 5d57219..c3308be 100644 --- a/lib/Fencer/AppState.hs +++ b/lib/Fencer/AppState.hs @@ -5,6 +5,8 @@ -- | In-memory state of Fencer. module Fencer.AppState ( AppState + , appStateCounters + , appStateRules , initAppState -- * Methods for working with 'AppState' @@ -27,10 +29,10 @@ import Named ((:!), arg) import qualified Focus as Focus import Control.Monad.Trans.Class (lift) -import Fencer.Types import Fencer.Counter -import Fencer.Time import Fencer.Rules +import Fencer.Time +import Fencer.Types -- | Fencer runtime context and in-memory state. -- @@ -158,7 +160,7 @@ getLimit appState domain descriptor = -- The 'appStateCounters' field stays unchanged. This is in accordance -- with the behavior of @lyft/ratelimit@. -- --- There might be a change in rulsets with the same descriptors that +-- There might be a change in rules with the same descriptors that -- updates the value of 'requests_per_unit' (with the time unit left -- intact), which allows a different number of requests to be -- made. This is as expected. However, if there is a change in the diff --git a/lib/Fencer/Counter.hs b/lib/Fencer/Counter.hs index e1f911b..5043b4c 100644 --- a/lib/Fencer/Counter.hs +++ b/lib/Fencer/Counter.hs @@ -36,7 +36,7 @@ data Counter = Counter -- | Counter expiry date, inclusive (i.e. on 'counterExpiry' the -- counter is already expired). , counterExpiry :: !Timestamp - } + } deriving Eq data CounterStatus = CounterStatus { -- | How many hits can be taken before the limit is reached. Will be 0 diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index 714212c..74fddf4 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -7,23 +7,33 @@ module Fencer.Rules.Test ( test_loadRulesYaml , test_loadRulesNonYaml , test_loadRulesRecursively + , test_ruleLimitUnitChange ) where import BasePrelude +import qualified Data.HashMap.Strict as HM +import Data.List (sortOn) +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromJust) import Data.Text (Text) import qualified Data.Text.IO as TIO -import Test.Tasty (TestTree) -import Test.Tasty.HUnit (assertEqual, testCase) -import qualified System.IO.Temp as Temp import NeatInterpolation (text) +import qualified StmContainers.Map as StmMap +import qualified System.IO.Temp as Temp import System.FilePath (()) import System.Directory (createDirectoryIfMissing) -import Data.List (sortOn) +import Test.Tasty (TestTree, withResource) +import Test.Tasty.HUnit (assertBool, assertEqual, testCase) -import Fencer.Types +import Fencer.AppState (appStateCounters, appStateRules, recordHits, setRules) +import Fencer.Counter (CounterKey(..), counterHits) import Fencer.Rules +import Fencer.Types + +import Fencer.Server.Test (createServerAppState, destroyServerAppState) + -- | Test that 'loadRulesFromDirectory' loads rules from YAML files. test_loadRulesYaml :: TestTree @@ -71,6 +81,87 @@ test_loadRulesRecursively = (sortOn domainDefinitionId [domain1, domain2]) (sortOn domainDefinitionId definitions) +-- | Test that a rule limit unit change adds a new counter and leaves +-- the old one intact. +-- +-- TODO(md)-2019-10-11: Sometimes this test non-deterministically fails with: +-- +-- Got wrong gRPC error response +-- expected: ClientIOError (GRPCIOBadStatusCode StatusUnknown +-- (StatusDetails {unStatusDetails = "rate limit descriptor +-- list must not be empty"})) +-- but got: ClientIOError (GRPCIOBadStatusCode StatusUnavailable +-- (StatusDetails {unStatusDetails = "Endpoint read failed"})) +test_ruleLimitUnitChange :: TestTree +test_ruleLimitUnitChange = + -- TODO(md): creating a server here sometimes clashes with executing + -- server tests concurrently, which occasionally leads to test + -- failures. Fix this either by making sure the port hasn't been + -- binded or in some other way. + withResource createServerAppState destroyServerAppState $ \ioLogIdState -> + testCase "A rule limit unit change on rule reloading" $ do + Temp.withSystemTempDirectory "fencer-config-unit" $ \tempDir -> do + createDirectoryIfMissing True (tempDir dir) + + definitions1 <- writeLoad tempDir merchantLimitsText1 + (_, _, state) <- ioLogIdState + + atomically $ setRules state (mapRuleDefs definitions1) + + ruleTree :: RuleTree <- atomically $ fromJust <$> StmMap.lookup domainId (appStateRules state) + let ruleBranch :: RuleBranch = fromJust $ HM.lookup (ruleKey, Just ruleValue) ruleTree + let rateLimit = fromJust $ ruleBranchRateLimit ruleBranch + + -- Record a hit + void $ atomically $ recordHits state (#hits 1) (#limit rateLimit) counterKey1 + + mV1 <- atomically $ StmMap.lookup counterKey1 $ appStateCounters state + + -- Change rules in the configuration + definitions2 <- writeLoad tempDir merchantLimitsText2 + + -- Set the new rules and the rules reloaded flag + atomically $ setRules state (mapRuleDefs definitions2) + + mV1' <- atomically $ StmMap.lookup counterKey1 $ appStateCounters state + mV2 <- atomically $ StmMap.lookup counterKey2 $ appStateCounters state + + assertBool + "The original counter was not updated after recording a hit!" + ((counterHits <$> mV1) == Just 1) + assertBool + "The original counter was mistakenly updated in the meantime!" + (mV1 == mV1') + assertBool "The secondary counter was set!" (mV2 == Nothing) + where + mapRuleDefs :: [DomainDefinition] -> [(DomainId, RuleTree)] + mapRuleDefs defs = + [ ( domainDefinitionId rule + , definitionsToRuleTree (NE.toList . domainDefinitionDescriptors $ rule)) + | rule <- defs + ] + + dir = "d11-ratelimits" + cfgFile = "d11-ratelimits1.yaml" + + writeLoad :: FilePath -> Text -> IO [DomainDefinition] + writeLoad tempDir txt = do + TIO.writeFile (tempDir dir cfgFile) txt + loadRulesFromDirectory (#directory tempDir) (#ignoreDotFiles True) + + ruleKey = RuleKey "generic_key" + ruleValue = RuleValue "dream11_order_create" + domainId = DomainId "merchant_rate_limits" + + counterKey1 = CounterKey + { counterKeyDomain = domainId + , counterKeyDescriptor = [ (ruleKey, ruleValue) ] + , counterKeyUnit = Minute } + + counterKey2 :: CounterKey + counterKey2 = counterKey1 { counterKeyUnit = Hour } + + ---------------------------------------------------------------------------- -- Sample definitions ---------------------------------------------------------------------------- @@ -117,3 +208,25 @@ domain2Text = [text| descriptors: - key: some key 2 |] + +merchantLimitsText1 :: Text +merchantLimitsText1 = [text| + domain: merchant_rate_limits + descriptors: + - key: generic_key + value: dream11_order_create + rate_limit: + unit: minute + requests_per_unit: 400000 + |] + +merchantLimitsText2 :: Text +merchantLimitsText2 = [text| + domain: merchant_rate_limits + descriptors: + - key: generic_key + value: dream11_order_create + rate_limit: + unit: hour + requests_per_unit: 400000 + |] diff --git a/test/Fencer/Server/Test.hs b/test/Fencer/Server/Test.hs index 834a685..ccb60da 100644 --- a/test/Fencer/Server/Test.hs +++ b/test/Fencer/Server/Test.hs @@ -6,6 +6,8 @@ -- | Tests for "Fencer.Server". module Fencer.Server.Test ( test_responseNoRules + , createServerAppState + , destroyServerAppState ) where @@ -72,13 +74,19 @@ test_responseNoRules = -- | Start Fencer on port 50051. createServer :: IO (Logger.Logger, ThreadId) createServer = do + (logger, threadId, _) <- createServerAppState + pure (logger, threadId) + +-- | Start Fencer on port 50051. +createServerAppState :: IO (Logger.Logger, ThreadId, AppState) +createServerAppState = do -- TODO: not the best approach. Ideally we should use e.g. -- https://hackage.haskell.org/package/tasty-hunit/docs/Test-Tasty-HUnit.html#v:testCaseSteps -- but we can't convince @tinylog@ to use the provided step function. logger <- Logger.create (Logger.Path "/dev/null") appState <- initAppState threadId <- forkIO $ runServer logger appState - pure (logger, threadId) + pure (logger, threadId, appState) -- | Kill Fencer. destroyServer :: (Logger.Logger, ThreadId) -> IO () @@ -86,6 +94,10 @@ destroyServer (logger, threadId) = do Logger.close logger killThread threadId +-- | Kill Fencer. +destroyServerAppState :: (Logger.Logger, ThreadId, AppState) -> IO () +destroyServerAppState (logger, threadId, _) = destroyServer (logger, threadId) + ---------------------------------------------------------------------------- -- gRPC client ---------------------------------------------------------------------------- From bdd1badfb5033533aa77e617c18d836798fd02ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 14 Oct 2019 15:56:30 +0200 Subject: [PATCH 3/5] 1) Make server and rule tests depend on each other such that there is no test failure due to external side effects. 2) Remove automatic test case detection due to test dependencies. --- fencer.cabal | 3 +-- test/Fencer/Rules/Test.hs | 37 +++++++++++----------------------- test/Fencer/Server/Test.hs | 6 +++--- test/Main.hs | 41 ++++++++++++++++++++++++++++++++++++++ test/Tests.hs | 1 - 5 files changed, 57 insertions(+), 31 deletions(-) create mode 100644 test/Main.hs delete mode 100644 test/Tests.hs diff --git a/fencer.cabal b/fencer.cabal index 27ab41b..a2fc1b8 100644 --- a/fencer.cabal +++ b/fencer.cabal @@ -106,7 +106,7 @@ test-suite test-fencer type: exitcode-stdio-1.0 main-is: - Tests.hs + Main.hs hs-source-dirs: test other-modules: @@ -128,7 +128,6 @@ test-suite test-fencer , proto3-suite , stm-containers , tasty - , tasty-discover , tasty-hunit , temporary , text diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index 74fddf4..3ca54f1 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -4,10 +4,10 @@ -- | Tests for "Fencer.Rules". module Fencer.Rules.Test - ( test_loadRulesYaml - , test_loadRulesNonYaml - , test_loadRulesRecursively - , test_ruleLimitUnitChange + ( test_rulesLoadRulesYaml + , test_rulesLoadRulesNonYaml + , test_rulesLoadRulesRecursively + , test_rulesLimitUnitChange ) where @@ -36,8 +36,8 @@ import Fencer.Server.Test (createServerAppState, destroyServerAppState -- | Test that 'loadRulesFromDirectory' loads rules from YAML files. -test_loadRulesYaml :: TestTree -test_loadRulesYaml = +test_rulesLoadRulesYaml :: TestTree +test_rulesLoadRulesYaml = testCase "Rules are loaded from YAML files" $ do Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do TIO.writeFile (tempDir "config1.yml") domain1Text @@ -52,8 +52,8 @@ test_loadRulesYaml = -- YAML files. -- -- This counterintuitive behavior matches the behavior of @lyft/ratelimit@. -test_loadRulesNonYaml :: TestTree -test_loadRulesNonYaml = +test_rulesLoadRulesNonYaml :: TestTree +test_rulesLoadRulesNonYaml = testCase "Rules are loaded from non-YAML files" $ do Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do TIO.writeFile (tempDir "config1.bin") domain1Text @@ -67,8 +67,8 @@ test_loadRulesNonYaml = -- | Test that 'loadRulesFromDirectory' loads rules recursively. -- -- This matches the behavior of @lyft/ratelimit@. -test_loadRulesRecursively :: TestTree -test_loadRulesRecursively = +test_rulesLoadRulesRecursively :: TestTree +test_rulesLoadRulesRecursively = testCase "Rules are loaded recursively" $ do Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do createDirectoryIfMissing True (tempDir "domain1") @@ -83,21 +83,8 @@ test_loadRulesRecursively = -- | Test that a rule limit unit change adds a new counter and leaves -- the old one intact. --- --- TODO(md)-2019-10-11: Sometimes this test non-deterministically fails with: --- --- Got wrong gRPC error response --- expected: ClientIOError (GRPCIOBadStatusCode StatusUnknown --- (StatusDetails {unStatusDetails = "rate limit descriptor --- list must not be empty"})) --- but got: ClientIOError (GRPCIOBadStatusCode StatusUnavailable --- (StatusDetails {unStatusDetails = "Endpoint read failed"})) -test_ruleLimitUnitChange :: TestTree -test_ruleLimitUnitChange = - -- TODO(md): creating a server here sometimes clashes with executing - -- server tests concurrently, which occasionally leads to test - -- failures. Fix this either by making sure the port hasn't been - -- binded or in some other way. +test_rulesLimitUnitChange :: TestTree +test_rulesLimitUnitChange = withResource createServerAppState destroyServerAppState $ \ioLogIdState -> testCase "A rule limit unit change on rule reloading" $ do Temp.withSystemTempDirectory "fencer-config-unit" $ \tempDir -> do diff --git a/test/Fencer/Server/Test.hs b/test/Fencer/Server/Test.hs index ccb60da..21837d0 100644 --- a/test/Fencer/Server/Test.hs +++ b/test/Fencer/Server/Test.hs @@ -5,7 +5,7 @@ -- | Tests for "Fencer.Server". module Fencer.Server.Test - ( test_responseNoRules + ( test_serverResponseNoRules , createServerAppState , destroyServerAppState ) @@ -30,8 +30,8 @@ import qualified Fencer.Proto as Proto -- 'reloadRules' has never been ran), requests to Fencer will error out. -- -- This behavior matches @lyft/ratelimit@. -test_responseNoRules :: TestTree -test_responseNoRules = +test_serverResponseNoRules :: TestTree +test_serverResponseNoRules = withResource createServer destroyServer $ \_ -> testCase "When no rules have been loaded, all requests error out" $ do Grpc.withGRPCClient clientConfig $ \grpcClient -> do diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 index 0000000..331ba9d --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,41 @@ +module Main where + +import Test.Tasty (after, defaultMain, testGroup, DependencyType(AllFinish), TestTree) + +import BasePrelude + +import qualified Fencer.Rules.Test as R +import qualified Fencer.Server.Test as S +import qualified Fencer.Types.Test as T + + +tests :: TestTree +tests = testGroup "All tests" + [ types + , rules + , after AllFinish "test_rules" server + ] + +server :: TestTree +server = testGroup "Server tests" [S.test_serverResponseNoRules] + +rules :: TestTree +rules = testGroup "Rule tests" + [ R.test_rulesLoadRulesYaml + , R.test_rulesLoadRulesNonYaml + , R.test_rulesLoadRulesRecursively + , R.test_rulesLimitUnitChange + ] + +types :: TestTree +types = testGroup "Type tests" + [ T.test_parseJSONDescriptorDefinition + , T.test_parseJSONDomainDefinition + , T.test_parseJSONDomainAtLeastOneDescriptor + , T.test_parseJSONNonEmptyDomainId + , T.test_parseJSONOptionalDescriptorFields + ] + + +main :: IO () +main = defaultMain tests diff --git a/test/Tests.hs b/test/Tests.hs deleted file mode 100644 index 327adf4..0000000 --- a/test/Tests.hs +++ /dev/null @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display #-} From 7c623159674b16323ab797359571c1109a8c375f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 14 Oct 2019 16:56:26 +0200 Subject: [PATCH 4/5] Issue #13: adds a note why 'after AllFinish' is used in testing --- test/Main.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/Main.hs b/test/Main.hs index 331ba9d..fd7831e 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -13,6 +13,11 @@ tests :: TestTree tests = testGroup "All tests" [ types , rules + -- 'after' is needed to avoid running the 'rules' and 'server' tests + -- concurrently. Running them concurrently is problematic because + -- both create a server (binding the same port) so if they create it + -- at the same time, one of the test groups will fail. The 'after' + -- function makes 'server' tests run after 'rules' tests. , after AllFinish "test_rules" server ] From 77b17232832401a6cfcd060a0fc4b39f79d77398 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Tue, 15 Oct 2019 08:45:49 +0200 Subject: [PATCH 5/5] Issue #13: replaces fromJust with fromMaybe --- test/Fencer/Rules/Test.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index 3ca54f1..dc704d9 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -16,7 +16,7 @@ import BasePrelude import qualified Data.HashMap.Strict as HM import Data.List (sortOn) import qualified Data.List.NonEmpty as NE -import Data.Maybe (fromJust) +import Data.Maybe (fromMaybe) import Data.Text (Text) import qualified Data.Text.IO as TIO import NeatInterpolation (text) @@ -95,9 +95,10 @@ test_rulesLimitUnitChange = atomically $ setRules state (mapRuleDefs definitions1) - ruleTree :: RuleTree <- atomically $ fromJust <$> StmMap.lookup domainId (appStateRules state) - let ruleBranch :: RuleBranch = fromJust $ HM.lookup (ruleKey, Just ruleValue) ruleTree - let rateLimit = fromJust $ ruleBranchRateLimit ruleBranch + ruleTree :: RuleTree <- atomically $ + fromMaybe' <$> StmMap.lookup domainId (appStateRules state) + let ruleBranch = fromMaybe' $ HM.lookup (ruleKey, Just ruleValue) ruleTree + let rateLimit = fromMaybe' $ ruleBranchRateLimit ruleBranch -- Record a hit void $ atomically $ recordHits state (#hits 1) (#limit rateLimit) counterKey1 @@ -148,6 +149,9 @@ test_rulesLimitUnitChange = counterKey2 :: CounterKey counterKey2 = counterKey1 { counterKeyUnit = Hour } + fromMaybe' :: Maybe a -> a + fromMaybe' = fromMaybe (error "") + ---------------------------------------------------------------------------- -- Sample definitions