fix(users/Profpatsch/openlab-tools): deepseq cache content r/6861

Otherwise the table might potentially hold onto data from the website
request, it’s hard to say.

Change-Id: I786478bd1ce2d9775b3d0b57565d79666ef8a96f
Reviewed-on: https://cl.tvl.fyi/c/depot/+/9806
Autosubmit: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>

3 files changed, 9 insertions, 3 deletions

diff --git a/users/Profpatsch/openlab-tools/default.nix b/users/Profpatsch/openlab-tools/default.nix
index 1966c62a7c..9c1e48af9e 100644
--- a/users/Profpatsch/openlab-tools/default.nix
+++ b/users/Profpatsch/openlab-tools/default.nix
@@ -25,6 +25,7 @@ let
       pkgs.haskellPackages.pa-run-command
       pkgs.haskellPackages.aeson-better-errors
       pkgs.haskellPackages.blaze-html
+      pkgs.haskellPackages.deepseq
       pkgs.haskellPackages.hs-opentelemetry-sdk
       pkgs.haskellPackages.http-conduit
       pkgs.haskellPackages.http-types
diff --git a/users/Profpatsch/openlab-tools/openlab-tools.cabal b/users/Profpatsch/openlab-tools/openlab-tools.cabal
index 369a1cabb8..621c8a5c42 100644
--- a/users/Profpatsch/openlab-tools/openlab-tools.cabal
+++ b/users/Profpatsch/openlab-tools/openlab-tools.cabal
@@ -76,6 +76,7 @@ library
         blaze-html,
         bytestring,
         containers,
+        deepseq,
         unordered-containers,
         exceptions,
         filepath,
diff --git a/users/Profpatsch/openlab-tools/src/OpenlabTools.hs b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
index 056d2a5d22..b63b6a6012 100644
--- a/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
+++ b/users/Profpatsch/openlab-tools/src/OpenlabTools.hs
@@ -5,6 +5,7 @@
 
 module OpenlabTools where
 
+import Control.DeepSeq (NFData, deepseq)
 import Control.Monad.Logger qualified as Logger
 import Control.Monad.Logger.CallStack
 import Control.Monad.Reader
@@ -259,13 +260,15 @@ newCache result = do
   until <- getCurrentTime
   newIORef Cache {..}
 
-updateCache :: IORef (Cache a) -> a -> IO ()
-updateCache cache result = do
+updateCache :: (NFData a) => IORef (Cache a) -> a -> IO ()
+updateCache cache result' = do
+  -- make sure we don’t hold onto the world by deepseq-ing
+  let result = deepseq result' result'
   until <- getCurrentTime <&> ((5 * 60) `addUTCTime`)
   _ <- writeIORef cache Cache {..}
   pure ()
 
-updateCacheIfNewer :: (MonadUnliftIO m) => IORef (Cache b) -> m b -> m b
+updateCacheIfNewer :: (MonadUnliftIO m, NFData b) => IORef (Cache b) -> m b -> m b
 updateCacheIfNewer cache act = withRunInIO $ \runInIO -> do
   old <- readIORef cache
   now <- getCurrentTime
@@ -273,6 +276,7 @@ updateCacheIfNewer cache act = withRunInIO $ \runInIO -> do
     then do
       res <- runInIO act
       updateCache cache res
+
       pure res
     else pure old.result