Merge pull request #128 from NoRedInk/foxen/fxn-3673-aide-ci-flake-de…

…ployertesteffectspechs

use `MVar`s to implement recording of mocked requests for nri-http

nri-http/CHANGELOG.md

@@ -1,3 +1,7 @@
+# 0.5.0.3
+
+- Use an `MVar` instead of `IORef` for mocked requests to hopefully reduce flake in cases where concurrent (mocked) requests are being made
+
 # 0.5.0.2
 
 - Loosen types for `Http.Mock` helpers to allow for arbitrary error types

nri-http/nri-http.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           nri-http
-version:        0.5.0.2
+version:        0.5.0.3
 synopsis:       Make Elm style HTTP requests
 description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-http#readme>.
 category:       Web

nri-http/package.yaml

@@ -2,7 +2,7 @@ name: nri-http
 synopsis: Make Elm style HTTP requests
 description: Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-http#readme>.
 author: NoRedInk
-version: 0.5.0.2
+version: 0.5.0.3
 maintainer: [email protected]
 copyright: 2024 NoRedInk Corp.
 github: NoRedInk/haskell-libraries/nri-http

nri-http/src/Http/Mock.hs

@@ -16,11 +16,11 @@ module Http.Mock
   )
 where
 
+import qualified Control.Concurrent.MVar as MVar
 import qualified Data.Aeson as Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy
 import qualified Data.Dynamic as Dynamic
-import qualified Data.IORef
 import Data.String (fromString)
 import qualified Data.Text.Encoding
 import qualified Debug
@@ -76,21 +76,28 @@ stub ::
   (Internal.Handler -> Expect.Expectation) ->
   Expect.Expectation' (List a)
 stub responders stubbedTestBody = do
-  logRef <- Expect.fromIO (Data.IORef.newIORef [])
+  logRef <- Expect.fromIO (MVar.newMVar [])
   doAnything <- Expect.fromIO Platform.doAnythingHandler
   let mockHandler =
         Internal.Handler
           ( \req -> do
               (log, res) <- tryRespond responders req
-              Data.IORef.modifyIORef' logRef (\prev -> log : prev)
-                |> map Ok
-                |> Platform.doAnything doAnything
-              Prelude.pure res
+              -- `modifyMVar_` and `withMVar` aren't completely atomic so those
+              -- could introduce a source of flake if used.  that said, `takeMVar` +
+              -- `putMVar` aren't exception-safe.  this is fine for the simple
+              -- usecase of just prepending to the contained list but if this logic
+              -- ever needs to include potentially-exception-causing code we'll need
+              -- to think a bit harder
+              -- (ref: https://hackage.haskell.org/package/base-4.21.0.0/docs/Control-Concurrent-MVar.html#v:withMVar)
+              Platform.doAnything doAnything <| do
+                prev <- MVar.takeMVar logRef
+                MVar.putMVar logRef (log : prev)
+                Prelude.pure (Ok res)
           )
           (\_ -> Debug.todo "We don't mock third party HTTP calls yet")
           (\_ -> Debug.todo "We don't mock third party HTTP calls yet")
   Expect.around (\f -> f mockHandler) (Stack.withFrozenCallStack stubbedTestBody)
-  Expect.fromIO (Data.IORef.readIORef logRef)
+  Expect.fromIO (MVar.readMVar logRef)
     |> map List.reverse
 
 -- | Read the body of the request as text. Useful to check what data got