Make withErrors exception safe

input-output-hk · Dec 23, 2024 · 8317170 · 8317170
1 parent 8423cb3
commit 8317170
Show file tree

Hide file tree

Showing 2 changed files with 13 additions and 9 deletions.
diff --git a/fs-sim/CHANGELOG.md b/fs-sim/CHANGELOG.md
@@ -1,5 +1,12 @@
 # Revision history for fs-sim
 
+## ?.?.?.? -- ????-??-??
+
+### Patch
+
+* Fix a bug where `withErrors` would not put back the previous `Errors` when an
+  exception is thrown during execution of the function.
+
 ## 0.3.1.0 -- 2024-12-10
 
 ### Non-breaking

diff --git a/fs-sim/src/System/FS/Sim/Error.hs b/fs-sim/src/System/FS/Sim/Error.hs
@@ -572,15 +572,12 @@ runSimErrorFS mockFS errors action = do
 
 -- | Execute the next action using the given 'Errors'. After the action is
 -- finished, the previous 'Errors' are restored.
-withErrors :: MonadSTM m => StrictTVar m Errors -> Errors -> m a -> m a
-withErrors errorsVar tempErrors action = do
-    originalErrors <- atomically $ do
-      originalErrors <- readTVar errorsVar
-      writeTVar errorsVar tempErrors
-      return originalErrors
-    res <- action
-    atomically $ writeTVar errorsVar originalErrors
-    return res
+withErrors :: (MonadSTM m, MonadThrow m) => StrictTVar m Errors -> Errors -> m a -> m a
+withErrors errorsVar tempErrors action =
+    bracket
+      (atomically $ swapTVar errorsVar tempErrors)
+      (\originalErrors -> atomically $ swapTVar errorsVar originalErrors)
+      $ \_ -> action
 
 {-------------------------------------------------------------------------------
   Utilities