diff --git a/lib/Fencer/Rules.hs b/lib/Fencer/Rules.hs index ddd73f1..a2c0f42 100644 --- a/lib/Fencer/Rules.hs +++ b/lib/Fencer/Rules.hs @@ -7,6 +7,7 @@ module Fencer.Rules ( LoadRulesError(..) , prettyPrintErrors , loadRulesFromDirectory + , validatePotentialDomains , definitionsToRuleTree , domainToRuleTree , applyRules @@ -69,7 +70,7 @@ loadRulesFromDirectory let filteredFiles = if ignoreDotFiles then filter (not . isDotFile) files else files - finalChecks <$> mapM loadFile filteredFiles + validatePotentialDomains <$> mapM loadFile filteredFiles where loadFile :: FilePath -> IO (Either LoadRulesError (Maybe DomainDefinition)) loadFile file = catch @@ -117,25 +118,25 @@ loadRulesFromDirectory dirs <- filterM isDirectory other (files ++) <$> concatMapM listAllFiles dirs - -- | Perform final checks to make sure the behavior matches that - -- of @lyft/ratelimit@. - finalChecks - :: [Either LoadRulesError (Maybe DomainDefinition)] - -> Either [LoadRulesError] [DomainDefinition] - finalChecks res = case partitionEithers res of - (errs@(_:_), _ ) -> Left errs - ([] , mRules) -> do - -- check if there are any duplicate domains - let - rules = catMaybes mRules - groupedRules :: [NonEmpty DomainDefinition] = NE.groupBy - ((==) `on` (unDomainId . domainDefinitionId)) - (NE.fromList $ sortOn domainDefinitionId rules) - if (length @[] rules /= length @[] groupedRules) - then - let dupDomain = NE.head . head $ filter (\l -> NE.length l > 1) groupedRules - in Left . pure . LoadRulesDuplicateDomain . domainDefinitionId $ dupDomain - else Right rules +-- | Perform validation checks to make sure the behavior matches that +-- of @lyft/ratelimit@. +validatePotentialDomains + :: [Either LoadRulesError (Maybe DomainDefinition)] + -> Either [LoadRulesError] [DomainDefinition] +validatePotentialDomains res = case partitionEithers res of + (errs@(_:_), _ ) -> Left errs + ([] , mRules) -> do + -- check if there are any duplicate domains + let + rules = catMaybes mRules + groupedRules :: [NonEmpty DomainDefinition] = NE.groupBy + ((==) `on` (unDomainId . domainDefinitionId)) + (NE.fromList $ sortOn domainDefinitionId rules) + if (length @[] rules /= length @[] groupedRules) + then + let dupDomain = NE.head . head $ filter (\l -> NE.length l > 1) groupedRules + in Left . pure . LoadRulesDuplicateDomain . domainDefinitionId $ dupDomain + else Right rules -- | Convert a list of descriptors to a 'RuleTree'. definitionsToRuleTree :: [DescriptorDefinition] -> RuleTree diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index df15956..2a5df62 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -8,6 +8,7 @@ module Fencer.Rules.Test ( tests , writeAndLoadRules -- example values + , domain1 , domain1Text , domain2Text ) where @@ -259,6 +260,7 @@ test_rulesLoadRulesReadPermissions = , ("domain2" "config" "config.yml", domain2Text, id) ] ) (#result $ Right [domain2]) + -- | test that 'loadRulesFromDirectory' rejects a configuration with a -- duplicate domain. -- diff --git a/test/Fencer/Server/Test.hs b/test/Fencer/Server/Test.hs index e1aa853..e85cdae 100644 --- a/test/Fencer/Server/Test.hs +++ b/test/Fencer/Server/Test.hs @@ -199,28 +199,21 @@ test_serverResponseReadPermissions = test_serverResponseDuplicateDomain :: TestTree test_serverResponseDuplicateDomain = withResource createServer destroyServer $ \serverIO -> - testCase "In presence of duplicate domains all requests error" $ - Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do - server <- serverIO - RTest.writeAndLoadRules - (#ignoreDotFiles False) - (#root tempDir) - (#files files) - >>= \case - Left _ -> - withService server $ \service -> do - response <- Proto.rateLimitServiceShouldRateLimit service $ - Grpc.ClientNormalRequest request 1 mempty - expectError - (unknownError "no rate limit configuration loaded") - response - Right _ -> assertFailure $ - "Expected a failure, and got domain definitions instead" + testCase "In presence of duplicate domains all requests error" $ do + server <- serverIO + pure (validatePotentialDomains $ Right . Just <$> domains) >>= \case + Left _ -> + withService server $ \service -> do + response <- Proto.rateLimitServiceShouldRateLimit service $ + Grpc.ClientNormalRequest request 1 mempty + expectError + (unknownError "no rate limit configuration loaded") + response + Right _ -> assertFailure $ + "Expected a failure, and got domain definitions instead" where - files :: [(FilePath, Text, Dir.Permissions -> Dir.Permissions)] - files = - [ ("domain1" "config.yml", RTest.domain1Text, id) - , ("domain2" "config.yml", RTest.domain1Text, id) ] + domains :: [DomainDefinition] + domains = take 2 $ repeat RTest.domain1 request :: Proto.RateLimitRequest request = Proto.RateLimitRequest