macOS: rewrite fs config provider using fsnotify

glean.cabal.in

@@ -195,10 +195,11 @@ common deps
         ghc-prim >=0.5.2.0 && <0.11,
         parsec ^>=3.1.13.0,
         haxl >= 2.1.2.0 && < 2.6,
-        hinotify ^>= 0.4.1
+        fsnotify ^>= 0.4.2.0
+
 
 common hsc2hs-cpp
-    hsc2hs-options: --cc=g++ --lflag=-lstdc++ --cflag=-D__HSC2HS__=1 --cflag=-std=c++17
+    hsc2hs-options: --cc=c++ --lflag=-lstdc++ --cflag=-D__HSC2HS__=1 --cflag=-std=c++17
 
 common thrift-server
     if flag(fbthrift)
@@ -394,8 +395,9 @@ library rts
         glean/rts/thrift.h
         glean/rts/timer.h
         glean/rts/validate.h
-    -- __atomic_is_lock_free missing with clang
-    extra-libraries: atomic
+    if os(linux)
+        -- __atomic_is_lock_free missing with clang
+        extra-libraries: atomic
     pkgconfig-depends: libunwind, libglog, icu-uc, gflags, libxxhash
 
 library storage
@@ -1950,6 +1952,10 @@ common angle-test
         glean:schema,
         glean:typed
 
+common util-test
+    build-depends:
+        glean:stubs,
+
 test-suite angle-test-angle
     import: test, angle-test
     type: exitcode-stdio-1.0
@@ -2175,6 +2181,15 @@ test-suite catalog
         quickcheck-io,
         glean:util
 
+test-suite configprovider
+    import: test, util-test
+    type: exitcode-stdio-1.0
+    main-is: ConfigProviderTest.hs
+    ghc-options: -main-is ConfigProviderTest
+    hs-source-dirs: glean/util/tests
+    build-depends:
+        glean:util,
+
 test-suite lifecycle
     import: test
     type: exitcode-stdio-1.0

glean/util/Glean/Impl/ConfigProvider.hs

@@ -18,8 +18,8 @@ module Glean.Impl.ConfigProvider (
 
 import Control.Concurrent
 import Control.Exception
+import Data.Maybe (fromMaybe)
 import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Char8 as BC
 import Data.ByteString (ByteString)
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HashMap
@@ -29,17 +29,22 @@ import Options.Applicative
 import System.Directory
 import System.FilePath
 import System.IO.Error
-import System.INotify
+
+import qualified System.FSNotify as FSNotify
 
 import Util.Control.Exception
+import Util.Concurrent
 
 import Glean.Util.ConfigProvider
 
 data ConfigAPI = ConfigAPI
-  { opts :: LocalConfigOptions
-  , inotify :: INotify
+  { canonConfigDir :: FilePath
+  , opts :: LocalConfigOptions
+  -- ^ Canonicalized configuration directory (since the file watcher will
+  -- likely canonicalize paths).
+  , watchManager :: FSNotify.WatchManager
   , subscriptions ::
-      MVar (HashMap ConfigPath (WatchDescriptor, [ByteString -> IO ()]))
+      IO (MVar (HashMap ConfigPath [ByteString -> IO ()]))
   }
 
 newtype LocalConfigOptions = LocalConfigOptions
@@ -57,6 +62,22 @@ newtype ConfigProviderException = ConfigProviderException Text
 
 instance Exception ConfigProviderException
 
+-- | Whether to accept a FS event for a given path
+acceptEvent :: FSNotify.Event -> Bool
+acceptEvent (FSNotify.Added _path _time FSNotify.IsFile) = True
+acceptEvent (FSNotify.Modified _path _time FSNotify.IsFile) = True
+-- Included for documentation of intent
+acceptEvent (FSNotify.Removed _path _time _isDir) = False
+acceptEvent (FSNotify.ModifiedAttributes _path _time _isDir) = False
+acceptEvent _ = False
+
+onEvent :: MVar (HashMap ConfigPath [ByteString -> IO ()]) -> FilePath -> IO ()
+onEvent subs path = do
+  callbacks <- fromMaybe [] . HashMap.lookup (Text.pack path) <$> readMVar subs
+  contents <- ByteString.readFile path
+  mapM_ ($ contents) callbacks
+    `catchAll` \_ -> return ()
+
 instance ConfigProvider ConfigAPI where
   configOptions = do
     configDir <- optional $ strOption
@@ -70,46 +91,42 @@ instance ConfigProvider ConfigAPI where
   defaultConfigOptions = LocalConfigOptions { configDir = Nothing }
 
   withConfigProvider opts f =
-    withINotify $ \inotify -> do
+    FSNotify.withManager $ \watchManager -> do
       subs <- newMVar HashMap.empty
-      f (ConfigAPI opts inotify subs)
+      -- fsnotify seems to give us canonicalized absolute paths back; we would
+      -- like to look things up by the paths it gives us, so we need to have
+      -- our own paths be canonicalized and absolute as well.
+      canonConfigDir <- canonicalizePath =<< getDir opts
+      -- Defer watcher startup until someone actually subscribes to an event
+      -- (notably, proving that the config directory actually exists so that we
+      -- can watch it, as watching a nonexistent directory on Linux is an
+      -- error).
+      subs' <- cacheSuccess
+        (subs <$ FSNotify.watchTree watchManager canonConfigDir acceptEvent (\ev -> onEvent subs (FSNotify.eventPath ev)))
+      let cfg = ConfigAPI canonConfigDir opts watchManager subs'
+      f cfg
 
   type Subscription ConfigAPI = LocalSubscription
 
   subscribe cfg@ConfigAPI{..} path updated deserializer = do
     a <- get cfg path deserializer
     updated a
-    dir <- getDir opts
-    modifyMVar_ subscriptions $ \hm -> do
-      let
-        changed contents =
-          deserialize path deserializer contents >>= updated
-      case HashMap.lookup path hm of
-        Just (watch, others) ->
-          return $ HashMap.insert path (watch, changed:others) hm
-        Nothing -> do
-          let file = BC.pack $ dir </> Text.unpack path
-          watch <- addWatch inotify [Modify,MoveIn,Create] file $ \_events -> do
-            callbacks <- withMVar subscriptions $ \hm -> do
-              case HashMap.lookup path hm of
-                Nothing -> return []
-                Just (_, callbacks) -> return callbacks
-            contents <- ByteString.readFile (dir </> Text.unpack path)
-            mapM_ ($ contents) callbacks
-              `catchAll` \_ -> return ()
-          return $ HashMap.insert path (watch, [changed]) hm
+    let absPath = Text.pack $ canonConfigDir </> Text.unpack path
+    subscriptions >>= \subs -> modifyMVar_ subs $ \hm ->
+      let changed contents =
+            deserialize path deserializer contents >>= updated
+      in pure $ HashMap.insertWith (<>) absPath [changed] hm
     return LocalSubscription
 
   cancel _ _ = return () -- unimplemented for now
 
   get ConfigAPI{..} path deserializer = do
-    dir <- getDir opts
-    contents <- ByteString.readFile (dir </> Text.unpack path)
+    contents <- ByteString.readFile (canonConfigDir </> Text.unpack path)
       `catch` \e ->
         if isDoesNotExistError e
           then throwIO $ ConfigProviderException $
             "no config for " <> path <> " at " <>
-              Text.pack (dir </> Text.unpack path)
+              Text.pack (canonConfigDir </> Text.unpack path)
           else
             throwIO e
     deserialize path deserializer contents