From bf41f517489b021710cf85d02f70ac521238a04d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 25 Nov 2019 15:24:41 +0100 Subject: [PATCH] Issue #26: Support handling configuration files without read permissions (#102) * Add a rule test for a file without read permissions * Add a server test for a file without read permissions * Reorganize the `Fencer.Rules.Test` module * Better handle read permissions --- fencer.cabal | 3 + lib/Fencer/Rules.hs | 43 ++++-- test/Fencer/Rules/Test.hs | 224 +++++++++-------------------- test/Fencer/Rules/Test/Examples.hs | 121 ++++++++++++++++ test/Fencer/Rules/Test/Helpers.hs | 99 +++++++++++++ test/Fencer/Rules/Test/Types.hs | 27 ++++ test/Fencer/Server/Test.hs | 86 ++++++++++- 7 files changed, 423 insertions(+), 180 deletions(-) create mode 100644 test/Fencer/Rules/Test/Examples.hs create mode 100644 test/Fencer/Rules/Test/Helpers.hs create mode 100644 test/Fencer/Rules/Test/Types.hs diff --git a/fencer.cabal b/fencer.cabal index 66e9c89..3698569 100644 --- a/fencer.cabal +++ b/fencer.cabal @@ -114,6 +114,9 @@ test-suite test-fencer Fencer.Logic.Test Fencer.Types.Test Fencer.Rules.Test + Fencer.Rules.Test.Examples + Fencer.Rules.Test.Helpers + Fencer.Rules.Test.Types Fencer.Server.Test default-language: Haskell2010 diff --git a/lib/Fencer/Rules.hs b/lib/Fencer/Rules.hs index 0106f1f..475ce50 100644 --- a/lib/Fencer/Rules.hs +++ b/lib/Fencer/Rules.hs @@ -6,6 +6,7 @@ module Fencer.Rules ( LoadRulesError(..) , prettyPrintErrors + , showError , loadRulesFromDirectory , definitionsToRuleTree , domainToRuleTree @@ -16,12 +17,12 @@ where import BasePrelude import Control.Applicative (liftA2) -import Control.Monad.Extra (partitionM, concatMapM) +import Control.Monad.Extra (partitionM, concatMapM, ifM) import Data.Either (partitionEithers) -import Data.Either.Combinators (mapLeft) +import Data.Maybe (catMaybes) import qualified Data.HashMap.Strict as HM import Named ((:!), arg) -import System.Directory (listDirectory, doesFileExist, doesDirectoryExist, pathIsSymbolicLink) +import System.Directory (listDirectory, doesFileExist, doesDirectoryExist, getPermissions, pathIsSymbolicLink, readable) import System.FilePath ((), makeRelative, normalise, splitDirectories) import qualified Data.Yaml as Yaml @@ -32,14 +33,15 @@ data LoadRulesError | LoadRulesIOError IOException deriving stock (Show) +-- | Pretty-print a 'LoadRulesError'. +showError :: LoadRulesError -> String +showError (LoadRulesParseError file yamlEx) = + show file ++ ", " ++ (Yaml.prettyPrintParseException yamlEx) +showError (LoadRulesIOError ex) = "IO error: " ++ displayException ex + -- | Pretty-print a list of 'LoadRulesError's. prettyPrintErrors :: [LoadRulesError] -> String prettyPrintErrors = intercalate ", " . fmap showError - where - showError (LoadRulesParseError file yamlEx) = - show file ++ ", " ++ (Yaml.prettyPrintParseException yamlEx) - showError (LoadRulesIOError ex) = - "IO error: " ++ displayException ex -- | Read rate limiting rules from a directory, recursively. Files are -- assumed to be YAML, but do not have to have a @.yml@ extension. If @@ -65,13 +67,26 @@ loadRulesFromDirectory let filteredFiles = if ignoreDotFiles then filter (not . isDotFile) files else files - (errs, rules) <- partitionEithers <$> mapM loadFile filteredFiles - pure $ if (null @[] errs) then Right rules else Left errs + (errs, mRules) <- partitionEithers <$> mapM loadFile filteredFiles + pure $ if (null @[] errs) then Right (catMaybes mRules) else Left errs where - loadFile :: FilePath -> IO (Either LoadRulesError DomainDefinition) - loadFile file = catch - ((mapLeft (LoadRulesParseError file)) <$> Yaml.decodeFileEither @DomainDefinition file) - (pure . Left . LoadRulesIOError) + loadFile :: FilePath -> IO (Either LoadRulesError (Maybe DomainDefinition)) + loadFile file = + ifM (readable <$> getPermissions file) + (catch + (convertParseType file <$> Yaml.decodeFileEither @DomainDefinition file) + (pure . Left . LoadRulesIOError) + ) + (pure $ Right Nothing) + + -- | Convert to the needed sum type. + convertParseType + :: FilePath + -> Either Yaml.ParseException DomainDefinition + ---------------------------------------------- + -> Either LoadRulesError (Maybe DomainDefinition) + convertParseType _ (Right def) = Right $ Just def + convertParseType file (Left err) = Left $ LoadRulesParseError file err isDotFile :: FilePath -> Bool isDotFile file = diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index 108134a..6bc2e34 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -1,27 +1,24 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLabels #-} -- | Tests for "Fencer.Rules". -module Fencer.Rules.Test (tests) where +module Fencer.Rules.Test + ( tests + ) where import BasePrelude -import Data.List (sortOn) -import Data.Text (Text) -import qualified Data.Text.IO as TIO import qualified Data.Yaml as Yaml -import Named ((:!), arg) -import NeatInterpolation (text) -import qualified System.IO.Temp as Temp -import System.FilePath (splitFileName, ()) -import System.Directory (createDirectoryIfMissing) +import qualified System.Directory as Dir +import System.FilePath (()) import Test.Tasty (TestTree, testGroup) -import Test.Tasty.HUnit (assertBool, assertEqual, Assertion, testCase) +import Test.Tasty.HUnit (testCase) import Fencer.Rules -import Fencer.Types +import Fencer.Rules.Test.Examples +import Fencer.Rules.Test.Helpers (expectLoadRules) +import Fencer.Rules.Test.Types tests :: TestTree @@ -35,47 +32,9 @@ tests = testGroup "Rule tests" , test_rulesLoadRulesException , test_rulesLoadRulesMinimal , test_rulesYAMLSeparator + , test_rulesLoadRulesReadPermissions ] --- | Create given directory structure and check that 'loadRulesFromDirectory' --- produces expected result. -expectLoadRules - :: "ignoreDotFiles" :! Bool - -> "files" :! [(FilePath, Text)] - -> "result" :! Either [LoadRulesError] [DomainDefinition] - -> Assertion -expectLoadRules - (arg #ignoreDotFiles -> ignoreDotFiles) - (arg #files -> files) - (arg #result -> result) = - Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do - forM_ files $ \(path, txt) -> do - let (dir, file) = splitFileName path - createDirectoryIfMissing True (tempDir dir) - TIO.writeFile (tempDir dir file) txt - definitionsVal <- loadRulesFromDirectory - (#rootDirectory tempDir) - (#subDirectory ".") - (#ignoreDotFiles ignoreDotFiles) - case definitionsVal of - f@(Left _) -> - -- Paths to temporary files vary and there is not much point - -- in writing down exact expected exception messages so the - -- only assertion made is that the number of exceptions is the - -- same. - assertEqual - "unexpected failure" - (length . toErrorList $ result) - (length . toErrorList $ f) - Right definitions -> assertBool "unexpected definitions" - (((==) `on` show) - (sortOn domainDefinitionId <$> result) - (Right $ sortOn domainDefinitionId definitions)) - where - toErrorList :: Either [LoadRulesError] [DomainDefinition] -> [LoadRulesError] - toErrorList (Right _) = [] - toErrorList (Left fs) = fs - -- | test that 'loadRulesFromDirectory' loads rules from YAML files. test_rulesLoadRulesYaml :: TestTree test_rulesLoadRulesYaml = @@ -83,10 +42,10 @@ test_rulesLoadRulesYaml = expectLoadRules (#ignoreDotFiles True) (#files - [ ("config1.yml", domain1Text) - , ("config2.yaml", domain2Text) ] + [ simpleRuleFile "config1.yml" domainDescriptorKeyValueText + , simpleRuleFile "config2.yaml" domainDescriptorKeyText ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | test that 'loadRulesFromDirectory' does not load rules from a -- dot-directory when dot-files should be ignored. @@ -96,10 +55,15 @@ test_rulesLoadRulesDotDirectory = expectLoadRules (#ignoreDotFiles True) (#files - [ (".domain1" "config1.yml", domain1Text) - , ("domain2" "config2.yaml", domain2Text) ] + [ simpleRuleFile + (".domain1" "config1.yml") + domainDescriptorKeyValueText + , simpleRuleFile + ("domain2" "config2.yaml") + domainDescriptorKeyText + ] ) - (#result $ Right [domain2]) + (#result $ Right [domainDescriptorKey]) -- | test that 'loadRulesFromDirectory' ignores dot-files. test_rulesLoadRules_ignoreDotFiles :: TestTree @@ -108,10 +72,10 @@ test_rulesLoadRules_ignoreDotFiles = expectLoadRules (#ignoreDotFiles True) (#files - [ ("config1.yml", domain1Text) - , ("dir" ".config2.yaml", domain2Text) ] + [ simpleRuleFile "config1.yml" domainDescriptorKeyValueText + , simpleRuleFile ("dir" ".config2.yaml") domainDescriptorKeyText ] ) - (#result $ Right [domain1]) + (#result $ Right [domainDescriptorKeyValue]) -- | test that 'loadRulesFromDirectory' does not ignore dot files. test_rulesLoadRules_dontIgnoreDotFiles :: TestTree @@ -120,10 +84,10 @@ test_rulesLoadRules_dontIgnoreDotFiles = expectLoadRules (#ignoreDotFiles False) (#files - [ ("config1.yml", domain1Text) - , ("dir" ".config2.yaml", domain2Text) ] + [ simpleRuleFile "config1.yml" domainDescriptorKeyValueText + , simpleRuleFile ("dir" ".config2.yaml") domainDescriptorKeyText ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | Test that 'loadRulesFromDirectory' loads rules from all files, not just -- YAML files. @@ -135,10 +99,10 @@ test_rulesLoadRulesNonYaml = expectLoadRules (#ignoreDotFiles True) (#files - [ ("config1.bin", domain1Text) - , ("config2", domain2Text) ] + [ simpleRuleFile "config1.bin" domainDescriptorKeyValueText + , simpleRuleFile "config2" domainDescriptorKeyText ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | Test that 'loadRulesFromDirectory' loads rules recursively. -- @@ -149,10 +113,15 @@ test_rulesLoadRulesRecursively = expectLoadRules (#ignoreDotFiles True) (#files - [ ("domain1" "config.yml", domain1Text) - , ("domain2" "config" "config.yml", domain2Text) ] + [ simpleRuleFile + ("domain1" "config.yml") + domainDescriptorKeyValueText + , simpleRuleFile + ("domain2" "config" "config.yml") + domainDescriptorKeyText + ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | Test that 'loadRulesFromDirectory' returns exceptions for an -- invalid domain. The 'loadRulesFromDirectory' function fails to load @@ -163,12 +132,14 @@ test_rulesLoadRulesException = expectLoadRules (#ignoreDotFiles False) (#files - [ ("domain1.yaml", domain1Text) - , ("faultyDomain.yaml", faultyDomain) + [ simpleRuleFile "domain1.yaml" domainDescriptorKeyValueText + , simpleRuleFile "faultyDomain.yaml" faultyDomain ] ) (#result $ Left - [LoadRulesParseError "faultyDomain.yaml" $ Yaml.AesonException ""]) + [LoadRulesParseError "faultyDomain.yaml" $ + Yaml.AesonException + "Error in $.descriptors[1]: key \"key\" not present"]) -- | test that 'loadRulesFromDirectory' accepts a minimal -- configuration containing only the domain id. @@ -179,7 +150,7 @@ test_rulesLoadRulesMinimal = testCase "Minimal rules contain domain id only" $ expectLoadRules (#ignoreDotFiles False) - (#files [("min.yaml", minimalDomainText)] ) + (#files [simpleRuleFile "min.yaml" minimalDomainText]) (#result $ Right [minimalDomain]) -- | test that 'loadRulesFromDirectory' accepts a configuration that @@ -193,91 +164,26 @@ test_rulesYAMLSeparator = testCase "One domain after a YAML separator" $ expectLoadRules (#ignoreDotFiles False) - (#files [("sep.yaml", separatorDomainText)] ) + (#files [simpleRuleFile "sep.yaml" separatorDomainText] ) (#result $ Right [separatorDomain]) ----------------------------------------------------------------------------- --- Sample definitions ----------------------------------------------------------------------------- - -descriptor1 :: DescriptorDefinition -descriptor1 = DescriptorDefinition - { descriptorDefinitionKey = RuleKey "some key" - , descriptorDefinitionValue = Just $ RuleValue "some value" - , descriptorDefinitionRateLimit = Nothing - , descriptorDefinitionDescriptors = Nothing - } - -descriptor2 :: DescriptorDefinition -descriptor2 = DescriptorDefinition - { descriptorDefinitionKey = RuleKey "some key 2" - , descriptorDefinitionValue = Nothing - , descriptorDefinitionRateLimit = Nothing - , descriptorDefinitionDescriptors = Nothing - } - -domain1 :: DomainDefinition -domain1 = DomainDefinition - { domainDefinitionId = DomainId "domain1" - , domainDefinitionDescriptors = [descriptor1] - } - -domain1Text :: Text -domain1Text = [text| - domain: domain1 - descriptors: - - key: some key - value: some value - |] - -domain2 :: DomainDefinition -domain2 = DomainDefinition - { domainDefinitionId = DomainId "domain2" - , domainDefinitionDescriptors = [descriptor2] - } - -domain2Text :: Text -domain2Text = [text| - domain: domain2 - descriptors: - - key: some key 2 - |] - -faultyDomain :: Text -faultyDomain = [text| - domain: another - descriptors: - - key: key2 - rate_limit: - unit: minute - requests_per_unit: 20 - - keyz: key3 - rate_limit: - unit: hour - requests_per_unit: 10 - |] - -minimalDomain :: DomainDefinition -minimalDomain = DomainDefinition - { domainDefinitionId = DomainId "min" - , domainDefinitionDescriptors = [] - } - -minimalDomainText :: Text -minimalDomainText = [text| domain: min |] - -separatorDomainText :: Text -separatorDomainText = [text| - --- - domain: another - descriptors: - - key: some key - value: some value - - key: some key 2 - |] - -separatorDomain :: DomainDefinition -separatorDomain = DomainDefinition - { domainDefinitionId = DomainId "another" - , domainDefinitionDescriptors = [descriptor1, descriptor2] - } +-- | test that 'loadRulesFromDirectory' loads a configuration file in +-- presence of another configuration file without read permissions. +-- +-- This matches the behavior of @lyft/ratelimit@. +test_rulesLoadRulesReadPermissions :: TestTree +test_rulesLoadRulesReadPermissions = + testCase "Configuration file read permissions" $ + expectLoadRules + (#ignoreDotFiles False) + (#files [file1, file2]) + (#result $ Right [domainDescriptorKey]) + where + file1, file2 :: RuleFile + file1 = MkRuleFile + ("domain1" "config.yml") + domainDescriptorKeyValueText + (const Dir.emptyPermissions) + file2 = simpleRuleFile + ("domain2" "config" "config.yml") + domainDescriptorKeyText diff --git a/test/Fencer/Rules/Test/Examples.hs b/test/Fencer/Rules/Test/Examples.hs new file mode 100644 index 0000000..ef120e7 --- /dev/null +++ b/test/Fencer/Rules/Test/Examples.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +-- | Values used for rule and server testing. +module Fencer.Rules.Test.Examples + ( domainDescriptorKeyValue + , domainDescriptorKeyValueText + , domainDescriptorKey + , domainDescriptorKeyText + , faultyDomain + , minimalDomain + , minimalDomainText + , separatorDomain + , separatorDomainText + ) + where + +import BasePrelude + +import Data.Text (Text) +import NeatInterpolation (text) + +import Fencer.Types + + +-- | A descriptor definition with a key and value only. +descriptorKeyValue :: DescriptorDefinition +descriptorKeyValue = DescriptorDefinition + { descriptorDefinitionKey = RuleKey "some key" + , descriptorDefinitionValue = Just $ RuleValue "some value" + , descriptorDefinitionRateLimit = Nothing + , descriptorDefinitionDescriptors = Nothing + } + +-- | A descriptor definition with a key only. +descriptorKey :: DescriptorDefinition +descriptorKey = DescriptorDefinition + { descriptorDefinitionKey = RuleKey "some key 2" + , descriptorDefinitionValue = Nothing + , descriptorDefinitionRateLimit = Nothing + , descriptorDefinitionDescriptors = Nothing + } + +-- | A domain definition with a single descriptor with a key and +-- value. +domainDescriptorKeyValue :: DomainDefinition +domainDescriptorKeyValue = DomainDefinition + { domainDefinitionId = DomainId "domain1" + , domainDefinitionDescriptors = [descriptorKeyValue] + } + +-- | The text value corresponding to 'domainDescriptorKeyValue'. +domainDescriptorKeyValueText :: Text +domainDescriptorKeyValueText = [text| + domain: domain1 + descriptors: + - key: some key + value: some value + |] + +-- | A domain definition with a single descriptor with a key. +domainDescriptorKey :: DomainDefinition +domainDescriptorKey = DomainDefinition + { domainDefinitionId = DomainId "domain2" + , domainDefinitionDescriptors = [descriptorKey] + } + +domainDescriptorKeyText :: Text +domainDescriptorKeyText = [text| + domain: domain2 + descriptors: + - key: some key 2 + |] + +-- | A faulty domain text. The text has "keyz" instead of "key", which +-- makes domain parsers fail. +faultyDomain :: Text +faultyDomain = [text| + domain: another + descriptors: + - key: key2 + rate_limit: + unit: minute + requests_per_unit: 20 + - keyz: key3 + rate_limit: + unit: hour + requests_per_unit: 10 + |] + +-- | A minimal domain definition comprised of the domain ID only. +minimalDomain :: DomainDefinition +minimalDomain = DomainDefinition + { domainDefinitionId = DomainId "min" + , domainDefinitionDescriptors = [] + } + +-- | The text value corresponding to 'minimalDomain'. +minimalDomainText :: Text +minimalDomainText = [text| domain: min |] + +-- | A domain definition with one key with a value and one key without +-- a value. The result of parsing 'separatorDomainText' has to be this +-- value. +separatorDomain :: DomainDefinition +separatorDomain = DomainDefinition + { domainDefinitionId = DomainId "another" + , domainDefinitionDescriptors = [descriptorKeyValue, descriptorKey] + } + +-- | The text value that starts with a YAML document separator. It +-- corresponds to 'separatorDomain'. +separatorDomainText :: Text +separatorDomainText = [text| + --- + domain: another + descriptors: + - key: some key + value: some value + - key: some key 2 + |] diff --git a/test/Fencer/Rules/Test/Helpers.hs b/test/Fencer/Rules/Test/Helpers.hs new file mode 100644 index 0000000..5682b9b --- /dev/null +++ b/test/Fencer/Rules/Test/Helpers.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} + +-- | Module with helper functions used in rules and other testing. +module Fencer.Rules.Test.Helpers + ( writeContentsToFile + , writeAndLoadRules + , expectLoadRules + ) +where + +import BasePrelude + +import qualified Data.Text.IO as TIO +import Named ((:!), arg) +import qualified System.Directory as Dir +import System.FilePath (FilePath, takeDirectory, takeFileName, ()) +import qualified System.IO.Temp as Temp +import Test.Tasty.HUnit (assertBool, assertFailure, Assertion) + +import Fencer.Rules (LoadRulesError(..), loadRulesFromDirectory, prettyPrintErrors, showError) +import Fencer.Rules.Test.Types (RuleFile(..)) +import Fencer.Types (DomainDefinition(..)) + + +-- | Write contents to a path in the given root and modify file +-- permissions. +writeContentsToFile + :: "root" :! FilePath + -> "file" :! RuleFile + -> IO () +writeContentsToFile + (arg #root -> root) + (arg #file -> file) = do + + let + dir = takeDirectory (ruleFilePath file) + fullPath = root (ruleFilePath file) + Dir.createDirectoryIfMissing True (root dir) + TIO.writeFile fullPath (ruleFileContents file) + perms <- Dir.getPermissions fullPath + Dir.setPermissions fullPath (ruleFileModifyPermissions file perms) + +-- | Write the content of files at the given root and load the files. +writeAndLoadRules + :: "ignoreDotFiles" :! Bool + -> "root" :! FilePath + -> "files" :! [RuleFile] + -> IO (Either [LoadRulesError] [DomainDefinition]) +writeAndLoadRules + (arg #ignoreDotFiles -> ignoreDotFiles) + (arg #root -> root) + (arg #files -> files) = do + + forM_ files $ \file -> writeContentsToFile + (#root root) + (#file file) + loadRulesFromDirectory + (#rootDirectory root) + (#subDirectory ".") + (#ignoreDotFiles ignoreDotFiles) + +-- | Create given directory structure and check that +-- 'loadRulesFromDirectory' produces expected result such that file +-- permissions are configurable. +expectLoadRules + :: "ignoreDotFiles" :! Bool + -> "files" :! [RuleFile] + -> "result" :! Either [LoadRulesError] [DomainDefinition] + -> Assertion +expectLoadRules + (arg #ignoreDotFiles -> ignoreDotFiles) + (arg #files -> files) + (arg #result -> result) = + Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> + writeAndLoadRules + (#ignoreDotFiles ignoreDotFiles) + (#root tempDir) + (#files files) + >>= \case + Left errs -> + case result of + Right _ -> + assertFailure "Expected failures, got domain definitions!" + Left expectedErrs -> + assertBool ("Exceptions differ! Expected: " ++ + (prettyPrintErrors expectedErrs) ++ "\nGot: " ++ + (prettyPrintErrors errs)) + (((==) `on` (fmap showError)) + (sortBy (compare `on` showError) (trimPath <$> expectedErrs)) + (sortBy (compare `on` showError) (trimPath <$> errs))) + Right definitions -> assertBool "unexpected definitions" + (((==) `on` show) + (sortOn domainDefinitionId <$> result) + (Right $ sortOn domainDefinitionId definitions)) + where + trimPath :: LoadRulesError -> LoadRulesError + trimPath (LoadRulesParseError p ex) = LoadRulesParseError (takeFileName p) ex + trimPath e = e diff --git a/test/Fencer/Rules/Test/Types.hs b/test/Fencer/Rules/Test/Types.hs new file mode 100644 index 0000000..af2e3df --- /dev/null +++ b/test/Fencer/Rules/Test/Types.hs @@ -0,0 +1,27 @@ +-- | Types useful for rule testing. +module Fencer.Rules.Test.Types + ( RuleFile(..) + , simpleRuleFile) +where + +import BasePrelude + +import Data.Text (Text) +import qualified System.Directory as Dir +import System.FilePath (FilePath) + +-- | A record useful in testing, which groups together a file path, +-- its contents and file permissions. +data RuleFile = MkRuleFile + { -- | The path to the file + ruleFilePath :: FilePath + -- | The contents of the file in plain text + , ruleFileContents :: Text + -- | A function specifying how the file permissions should be + -- changed, i.e., what they should be once the file is written to + -- disk. + , ruleFileModifyPermissions :: Dir.Permissions -> Dir.Permissions + } + +simpleRuleFile :: FilePath -> Text -> RuleFile +simpleRuleFile p c = MkRuleFile p c id diff --git a/test/Fencer/Server/Test.hs b/test/Fencer/Server/Test.hs index 657ed91..d4ae86f 100644 --- a/test/Fencer/Server/Test.hs +++ b/test/Fencer/Server/Test.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE GADTs #-} @@ -13,19 +14,26 @@ where import BasePrelude -import Test.Tasty (TestTree, testGroup, withResource) -import Test.Tasty.HUnit (HasCallStack, assertEqual, assertFailure, testCase, Assertion) -import qualified System.Logger as Logger -import qualified System.IO.Temp as Temp -import qualified Network.GRPC.HighLevel.Generated as Grpc import Data.ByteString (ByteString) +import qualified Data.Vector as Vector import GHC.Exts (fromList) +import qualified Network.GRPC.HighLevel.Generated as Grpc +import Proto3.Suite.Types (Enumerated(..)) +import qualified System.Directory as Dir +import System.FilePath (()) +import qualified System.Logger as Logger +import qualified System.IO.Temp as Temp +import Test.Tasty (TestTree, testGroup, withResource) +import Test.Tasty.HUnit (HasCallStack, assertEqual, assertFailure, testCase, Assertion) import Fencer.Logic import Fencer.Server import Fencer.Settings (defaultGRPCPort, getLogLevel, newLogger) import Fencer.Types import Fencer.Rules +import Fencer.Rules.Test.Examples (domainDescriptorKeyValueText, domainDescriptorKeyText) +import Fencer.Rules.Test.Helpers (writeAndLoadRules) +import Fencer.Rules.Test.Types (RuleFile(..), simpleRuleFile) import qualified Fencer.Proto as Proto {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} @@ -39,6 +47,7 @@ tests = testGroup "Server tests" [ test_serverResponseNoRules , test_serverResponseEmptyDomain , test_serverResponseEmptyDescriptorList + , test_serverResponseReadPermissions ] -- | Test that when Fencer is started without any rules provided to it (i.e. @@ -124,6 +133,69 @@ test_serverResponseEmptyDescriptorList = , Proto.rateLimitRequestHitsAddend = 0 } +-- | Test that a request with a non-empty descriptor list results in an +-- OK response in presence of a configuration file without read +-- permissions. +-- +-- This behavior matches @lyft/ratelimit@. +test_serverResponseReadPermissions :: TestTree +test_serverResponseReadPermissions = + withResource createServer destroyServer $ \serverIO -> + testCase "OK response with one YAML file without read permissions" $ + Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do + server <- serverIO + writeAndLoadRules + (#ignoreDotFiles False) + (#root tempDir) + (#files files) + >>= \case + Left _ -> assertFailure "Failed to load a valid domain!" + Right rules -> do + atomically $ + setRules (serverAppState server) (domainToRuleTree <$> rules) + withService server $ \service -> do + response <- Proto.rateLimitServiceShouldRateLimit service $ + Grpc.ClientNormalRequest request 1 mempty + expectSuccess + (expectedResponse, Grpc.StatusOk) + response + where + files :: [RuleFile] + files = + [ MkRuleFile + ("domain1" "config.yml") + domainDescriptorKeyValueText + (const Dir.emptyPermissions) + , simpleRuleFile + ("domain2" "config" "config.yml") + domainDescriptorKeyText + ] + + request :: Proto.RateLimitRequest + request = Proto.RateLimitRequest + { Proto.rateLimitRequestDomain = "domain" + , Proto.rateLimitRequestDescriptors = + fromList $ + [ Proto.RateLimitDescriptor $ + fromList [Proto.RateLimitDescriptor_Entry "key" ""] + ] + , Proto.rateLimitRequestHitsAddend = 0 + } + + expectedResponse :: Proto.RateLimitResponse + expectedResponse = Proto.RateLimitResponse + { rateLimitResponseOverallCode = + Enumerated $ Right Proto.RateLimitResponse_CodeOK + , rateLimitResponseStatuses = Vector.singleton + Proto.RateLimitResponse_DescriptorStatus + { rateLimitResponse_DescriptorStatusCode = + Enumerated $ Right Proto.RateLimitResponse_CodeOK + , rateLimitResponse_DescriptorStatusCurrentLimit = Nothing + , rateLimitResponse_DescriptorStatusLimitRemaining = 0 + } + , rateLimitResponseHeaders = Vector.empty + } + ---------------------------------------------------------------------------- -- Helpers ---------------------------------------------------------------------------- @@ -136,12 +208,12 @@ domainDefinitionWithoutRules = DomainDefinition -- | Assert that a gRPC request is successful and has a specific result and -- status code. -_expectSuccess +expectSuccess :: (HasCallStack, Eq result, Show result) => (result, Grpc.StatusCode) -> Grpc.ClientResult 'Grpc.Normal result -> Assertion -_expectSuccess expected actual = case actual of +expectSuccess expected actual = case actual of Grpc.ClientErrorResponse actualError -> assertFailure $ "Expected a normal response, got an error response: " ++