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

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>
This commit is contained in:
Profpatsch 2023-10-20 13:58:49 +02:00 committed by clbot
parent c2893a5c77
commit 3dba987de4
3 changed files with 9 additions and 3 deletions

View file

@ -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

View file

@ -76,6 +76,7 @@ library
blaze-html,
bytestring,
containers,
deepseq,
unordered-containers,
exceptions,
filepath,

View file

@ -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 dont 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