Skip to content

Commit 4c1f8ed

Browse files
committedMay 16, 2025
fix: Fix race condition on WaiSpec (Copilot)
1 parent 4b5ebca commit 4c1f8ed

File tree

2 files changed

+6
-8
lines changed

2 files changed

+6
-8
lines changed
 

‎rollbar-wai/src/Rollbar/Wai.hs

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -50,21 +50,22 @@ rollbarOnException
5050
-> Maybe W.Request
5151
-> SomeException
5252
-> m ()
53-
rollbarOnException = rollbarOnExceptionWith (void . createItem)
53+
rollbarOnException settings = rollbarOnExceptionWith (void . forkIO) (void . createItem) settings
5454

5555
-- | Similar to 'rollbarOnExceptionWith', but it allows customize the function
5656
-- used to send the 'Item' to Rollbar.
5757
--
5858
-- @since 0.1.0
5959
rollbarOnExceptionWith
6060
:: MonadIO m
61-
=> (Item -> Rollbar ())
61+
=> (IO () -> IO ()) -- ^ fork function (returns unit)
62+
-> (Item -> Rollbar ())
6263
-> Settings
6364
-> Maybe W.Request
6465
-> SomeException
6566
-> m ()
66-
rollbarOnExceptionWith f settings waiRequest ex =
67-
void $ liftIO $ forkIO $ runRollbar settings $ do
67+
rollbarOnExceptionWith fork f settings waiRequest ex =
68+
void $ liftIO $ fork $ runRollbar settings $ do
6869
item <- mkItem $ PayloadTrace $ Trace [] $ mkException ex
6970
request <- mapM mkRequest waiRequest
7071
f item

‎rollbar-wai/test/Rollbar/WaiSpec.hs

Lines changed: 1 addition & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -10,7 +10,6 @@ import qualified Data.Text as T
1010
import qualified Network.Wai as W
1111
import qualified Network.Wai.Handler.Warp as W
1212

13-
import Control.Concurrent (threadDelay)
1413
import Control.Monad (join)
1514
import Control.Monad.IO.Class
1615
import Data.Aeson
@@ -33,7 +32,6 @@ spec = before getSettingsAndItemRef $
3332
(req GET url NoReqBody bsResponse $ port warpPort)
3433
responseStatusCode response `shouldBe` 200
3534
responseBody response `shouldBe` "OK"
36-
threadDelay 500
3735
readIORef itemRef `shouldReturn` Nothing
3836

3937
context "when the response status code is not 200" $
@@ -44,7 +42,6 @@ spec = before getSettingsAndItemRef $
4442
(defaultHttpConfig { httpConfigCheckResponse = \_ _ _ -> Nothing })
4543
(req GET url NoReqBody bsResponse $ port warpPort)
4644
response `shouldBe` "Something went wrong"
47-
threadDelay 500
4845
let portAsText = T.pack $ show warpPort
4946
join . fmap itemRequest <$> readIORef itemRef `shouldReturn` Just
5047
( Request
@@ -75,7 +72,7 @@ withApp
7572
-> IO a
7673
withApp f (settings, itemRef) = do
7774
let waiSettings = W.setOnException
78-
(rollbarOnExceptionWith (createItemFake itemRef) settings)
75+
(rollbarOnExceptionWith id (createItemFake itemRef) settings)
7976
W.defaultSettings
8077
W.withApplicationSettings waiSettings (return app) $ f itemRef
8178

0 commit comments

Comments
 (0)