From 71bdcfe57b1418ea28191091d57a67688a47daf2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marko=20Dimja=C5=A1evi=C4=87?= Date: Mon, 25 Nov 2019 11:40:16 +0100 Subject: [PATCH] Issue #26: move rule example values to a separate module --- fencer.cabal | 1 + lib/Fencer/Rules.hs | 4 +- test/Fencer/Rules/Test.hs | 145 ++++++----------------------- test/Fencer/Rules/Test/Examples.hs | 121 ++++++++++++++++++++++++ test/Fencer/Server/Test.hs | 6 +- 5 files changed, 157 insertions(+), 120 deletions(-) create mode 100644 test/Fencer/Rules/Test/Examples.hs diff --git a/fencer.cabal b/fencer.cabal index 4cf9587..3698569 100644 --- a/fencer.cabal +++ b/fencer.cabal @@ -114,6 +114,7 @@ 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 diff --git a/lib/Fencer/Rules.hs b/lib/Fencer/Rules.hs index 86fc497..2fd372c 100644 --- a/lib/Fencer/Rules.hs +++ b/lib/Fencer/Rules.hs @@ -69,8 +69,8 @@ loadRulesFromDirectory pure $ if (null @[] errs) then Right (catMaybes mRules) else Left errs where loadFile :: FilePath -> IO (Either LoadRulesError (Maybe DomainDefinition)) - loadFile file = do - ifM (getPermissions file >>= pure . readable) + loadFile file = + ifM (readable <$> getPermissions file) (catch (convertParseType file <$> Yaml.decodeFileEither @DomainDefinition file) (pure . Left . LoadRulesIOError) diff --git a/test/Fencer/Rules/Test.hs b/test/Fencer/Rules/Test.hs index f706920..ef8b69b 100644 --- a/test/Fencer/Rules/Test.hs +++ b/test/Fencer/Rules/Test.hs @@ -1,30 +1,24 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLabels #-} -- | Tests for "Fencer.Rules". module Fencer.Rules.Test ( tests - -- example values - , domain1Text - , domain2Text ) where import BasePrelude -import Data.Text (Text) import qualified Data.Yaml as Yaml -import NeatInterpolation (text) import qualified System.Directory as Dir import System.FilePath (()) import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit (testCase) import Fencer.Rules +import Fencer.Rules.Test.Examples import Fencer.Rules.Test.Helpers (expectLoadRules) import Fencer.Rules.Test.Types -import Fencer.Types tests :: TestTree @@ -48,10 +42,10 @@ test_rulesLoadRulesYaml = expectLoadRules (#ignoreDotFiles True) (#files - [ simpleRuleFile "config1.yml" domain1Text - , simpleRuleFile "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. @@ -61,10 +55,15 @@ test_rulesLoadRulesDotDirectory = expectLoadRules (#ignoreDotFiles True) (#files - [ simpleRuleFile (".domain1" "config1.yml") domain1Text - , simpleRuleFile ("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 @@ -73,10 +72,10 @@ test_rulesLoadRules_ignoreDotFiles = expectLoadRules (#ignoreDotFiles True) (#files - [ simpleRuleFile "config1.yml" domain1Text - , simpleRuleFile ("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 @@ -85,10 +84,10 @@ test_rulesLoadRules_dontIgnoreDotFiles = expectLoadRules (#ignoreDotFiles False) (#files - [ simpleRuleFile "config1.yml" domain1Text - , simpleRuleFile ("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. @@ -100,10 +99,10 @@ test_rulesLoadRulesNonYaml = expectLoadRules (#ignoreDotFiles True) (#files - [ simpleRuleFile "config1.bin" domain1Text - , simpleRuleFile "config2" domain2Text ] + [ simpleRuleFile "config1.bin" domainDescriptorKeyValueText + , simpleRuleFile "config2" domainDescriptorKeyText ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | Test that 'loadRulesFromDirectory' loads rules recursively. -- @@ -114,13 +113,15 @@ test_rulesLoadRulesRecursively = expectLoadRules (#ignoreDotFiles True) (#files - [ simpleRuleFile ("domain1" "config.yml") domain1Text + [ simpleRuleFile + ("domain1" "config.yml") + domainDescriptorKeyValueText , simpleRuleFile ("domain2" "config" "config.yml") - domain2Text + domainDescriptorKeyText ] ) - (#result $ Right [domain1, domain2]) + (#result $ Right [domainDescriptorKeyValue, domainDescriptorKey]) -- | Test that 'loadRulesFromDirectory' returns exceptions for an -- invalid domain. The 'loadRulesFromDirectory' function fails to load @@ -131,7 +132,7 @@ test_rulesLoadRulesException = expectLoadRules (#ignoreDotFiles False) (#files - [ simpleRuleFile "domain1.yaml" domain1Text + [ simpleRuleFile "domain1.yaml" domainDescriptorKeyValueText , simpleRuleFile "faultyDomain.yaml" faultyDomain ] ) @@ -174,99 +175,13 @@ test_rulesLoadRulesReadPermissions = expectLoadRules (#ignoreDotFiles False) (#files [file1, file2]) - (#result $ Right [domain2]) + (#result $ Right [domainDescriptorKey]) where file1, file2 :: RuleFile file1 = MkRuleFile ("domain1" "config.yml") - domain1Text + domainDescriptorKeyValueText (const Dir.emptyPermissions) file2 = simpleRuleFile ("domain2" "config" "config.yml") - domain2Text - ----------------------------------------------------------------------------- --- 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] - } + 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/Server/Test.hs b/test/Fencer/Server/Test.hs index 36304a4..d4ae86f 100644 --- a/test/Fencer/Server/Test.hs +++ b/test/Fencer/Server/Test.hs @@ -31,7 +31,7 @@ import Fencer.Server import Fencer.Settings (defaultGRPCPort, getLogLevel, newLogger) import Fencer.Types import Fencer.Rules -import qualified Fencer.Rules.Test as RTest +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 @@ -164,11 +164,11 @@ test_serverResponseReadPermissions = files = [ MkRuleFile ("domain1" "config.yml") - RTest.domain1Text + domainDescriptorKeyValueText (const Dir.emptyPermissions) , simpleRuleFile ("domain2" "config" "config.yml") - RTest.domain2Text + domainDescriptorKeyText ] request :: Proto.RateLimitRequest