Load rules recursively

fencer.cabal

@@ -57,6 +57,7 @@ library
   build-depends:
     base,
     base-prelude,
+    extra,
     hashable,
     monad-loops,
     time,
@@ -119,6 +120,7 @@ test-suite test-fencer
     , aeson-qq
     , base
     , base-prelude
+    , directory
     , grpc-haskell
     , filepath
     , neat-interpolation

lib/Fencer/Rules.hs

@@ -12,16 +12,17 @@ where
 
 import BasePrelude
 
+import Control.Monad.Extra (partitionM, concatMapM)
 import qualified Data.HashMap.Strict as HM
 import Named ((:!), arg)
-import System.Directory (listDirectory, doesFileExist)
+import System.Directory (listDirectory, doesFileExist, doesDirectoryExist, pathIsSymbolicLink)
 import System.FilePath ((</>), takeFileName)
 import qualified Data.Yaml as Yaml
 
 import Fencer.Types
 
--- | Gather rate limiting rules (*.yml, *.yaml) from a directory.
--- Subdirectories are not included.
+-- | Read rate limiting rules from a directory, recursively. Files are
+-- assumed to be YAML, but do not have to have a @.yml@ extension.
 --
 -- Throws an exception for unparseable or unreadable files.
 loadRulesFromDirectory
@@ -33,9 +34,7 @@ loadRulesFromDirectory
     (arg #ignoreDotFiles -> ignoreDotFiles)
     =
     do
-    files <-
-        filterM doesFileExist . map (directory </>) =<<
-        listDirectory directory
+    files <- listAllFiles directory
     mapM Yaml.decodeFileThrow $
         if ignoreDotFiles
             then filter (not . isDotFile) files
@@ -44,6 +43,27 @@ loadRulesFromDirectory
     isDotFile :: FilePath -> Bool
     isDotFile file = "." `isPrefixOf` takeFileName file
 
+    -- | Is the path a true directory (not a symlink)?
+    isDirectory :: FilePath -> IO Bool
+    isDirectory dir =
+        liftA2 (&&)
+            (doesDirectoryExist dir)
+            (not <$> (pathIsSymbolicLink dir `catchIOError` \_ -> pure False))
+
+    -- | List all files in a directory, recursively, without following
+    -- symlinks.
+    listAllFiles :: FilePath -> IO [FilePath]
+    listAllFiles dir = do
+        -- TODO: log exceptions
+        contents <-
+            map (dir </>) <$>
+            (listDirectory dir `catchIOError` \_ -> pure [])
+        -- files = normal files and links to files
+        -- dirs = directories, but not links to directories
+        (files, other) <- partitionM doesFileExist contents
+        dirs <- filterM isDirectory other
+        (files ++) <$> concatMapM listAllFiles dirs
+
 -- | Convert a list of descriptors to a 'RuleTree'.
 definitionsToRuleTree :: [DescriptorDefinition] -> RuleTree
 definitionsToRuleTree = HM.fromList . map (\d -> (makeKey d, makeBranch d))

test/Fencer/Rules/Test.hs

@@ -6,6 +6,7 @@
 module Fencer.Rules.Test
   ( test_loadRulesYaml
   , test_loadRulesNonYaml
+  , test_loadRulesRecursively
   )
 where
 
@@ -18,6 +19,7 @@ import           Test.Tasty.HUnit (assertEqual, testCase)
 import qualified System.IO.Temp as Temp
 import           NeatInterpolation (text)
 import           System.FilePath ((</>))
+import           System.Directory (createDirectoryIfMissing)
 import           Data.List (sortOn)
 
 import           Fencer.Types
@@ -52,6 +54,23 @@ test_loadRulesNonYaml =
         (sortOn domainDefinitionId [domain1, domain2])
         (sortOn domainDefinitionId definitions)
 
+-- | Test that 'loadRulesFromDirectory' loads rules recursively.
+--
+-- This matches the behavior of @lyft/ratelimit@.
+test_loadRulesRecursively :: TestTree
+test_loadRulesRecursively =
+  testCase "Rules are loaded recursively" $ do
+    Temp.withSystemTempDirectory "fencer-config" $ \tempDir -> do
+      createDirectoryIfMissing True (tempDir </> "domain1")
+      TIO.writeFile (tempDir </> "domain1/config.yml") domain1Text
+      createDirectoryIfMissing True (tempDir </> "domain2/config")
+      TIO.writeFile (tempDir </> "domain2/config/config.yml") domain2Text
+      definitions <-
+        loadRulesFromDirectory (#directory tempDir) (#ignoreDotFiles True)
+      assertEqual "unexpected definitions"
+        (sortOn domainDefinitionId [domain1, domain2])
+        (sortOn domainDefinitionId definitions)
+
 ----------------------------------------------------------------------------
 -- Sample definitions
 ----------------------------------------------------------------------------