refactor(utils): minor changes for timeoutHandler

src/Handler/Utils.hs

@@ -35,7 +35,7 @@ import Handler.Utils.Qualification as Handler.Utils
 
 import Handler.Utils.Term as Handler.Utils
 
-import Handler.Utils.Concurrent as Handler.Utils
+-- import Handler.Utils.Concurrent as Handler.Utils -- only imported when needed
 
 import Control.Monad.Logger
 

src/Handler/Utils/Concurrent.hs

@@ -3,30 +3,36 @@
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
 module Handler.Utils.Concurrent
-  ( module Handler.Utils.Concurrent
+  ( module Handler.Utils.Concurrent  
   ) where
 
+-- NOTE: use `retrySTM` and `checkSTM` instead of `retry` or `check`
 
 import Import
-import UnliftIO.Concurrent
+import UnliftIO.Concurrent as Handler.Utils.Concurrent hiding (yield)
+
 
 
 -- | Run a handler action until it finishes or if it exceeds a given number of microseconds via `registerDelay`
 timeoutHandler :: Int -> HandlerFor site a -> HandlerFor site (Maybe a)
 timeoutHandler maxWait act = do
     innerAct <- handlerToIO
-    (hresult, tid) <- liftIO $ do 
+    (hresult, tid) <- liftIO $ do
       hresult <- newTVarIO Nothing
-      tid <- forkIO $ innerAct $ do 
+      tid <- forkIO $ do
-        res <- act
+        res <- innerAct act
-        liftIO $ atomically $ writeTVar hresult $ Just res
+        atomically $ writeTVar hresult $ Just res
       return (hresult, tid)
     res <- liftIO $ do
       flag <- registerDelay maxWait
-      atomically $ do 
+      atomically $ do
-        res <- readTVar hresult
         out <- readTVar flag
+        res <- readTVar hresult
         checkSTM $ out || isJust res
         return res
-    when (isNothing res) $ killThread tid
+    case res of
-    return res
+      Nothing -> liftIO $ do
+        killThread tid
+        readTVarIO hresult     -- read once more after kill to ensure that any result is noticed
+      _ -> return res
+