From d00e385942a90e7e0600ee878db5d6c9120a6558 Mon Sep 17 00:00:00 2001
From: Alexander Foremny <aforemny@posteo.de>
Date: Sun, 13 Oct 2024 12:16:15 +0200
Subject: fix race on repository watch
---
backend/app/Main.hs | 17 +++++++++++++----
1 file changed, 13 insertions(+), 4 deletions(-)
diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index c31ea7d..917a6d9 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -13,7 +13,7 @@ import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception (throwIO)
import Control.Monad
-import Control.Monad.Catch (Exception)
+import Control.Monad.Catch (Exception, SomeException, catch, displayException)
import Control.Monad.Trans (liftIO)
import Data.Aeson qualified as J
import Data.Aeson.KeyMap qualified as JM
@@ -127,13 +127,22 @@ watch repoT root ref = do
addWatch i [Create, MoveIn] ".git/refs/heads" $ \e -> do
when (e.filePath == B.fromString (takeBaseName (T.unpack ref))) do
atomically (writeTQueue qT e)
+ repo <- initRepo root ref
+ atomically do putTMVar repoT repo
forever do
- repo <- initRepo root ref
- atomically do putTMVar repoT repo
_ <- atomically do
let loop = maybe (pure ()) (const loop) =<< tryReadTQueue qT
readTQueue qT >> loop
- _ <- atomically do takeTMVar repoT
+ repo' <- atomically do takeTMVar repoT
+ catch
+ ( do
+ repo <- initRepo root ref
+ atomically do putTMVar repoT repo
+ )
+ ( \(e :: SomeException) -> do
+ printf "warning: %s\n" (displayException e)
+ atomically do putTMVar repoT repo'
+ )
pure ()
initRepo :: FilePath -> G.RefName -> IO Repo
--
cgit v1.2.3