haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Fix memory leak during stackage cron job when caching is enabled

Browse Source
This commit is contained in:
Alexey Kuleshevich 2019-06-26 12:14:51 +03:00
parent 8ae7dc234a
commit d9a285a87f
No known key found for this signature in database
GPG Key ID: E59B216127119E3E
1 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Stackage/Database/Cron.hs
View File

@ -14,6 +14,7 @@ module Stackage.Database.Cron
) where
import Conduit
import Control.DeepSeq
import Control.Lens ((.~))
import qualified Control.Monad.Trans.AWS as AWS (paginate)
import Control.SingleRun
@ -274,7 +275,7 @@ makeCorePackageGetter _compiler pname ver =
Just (gpd, treeId) -> do
mTree <- run $ getEntity treeId
let pkgInfo = (mTree, Just hackageCabalId, pid, gpd)
writeIORef pkgInfoRef $ Just pkgInfo
gpd `deepseq` writeIORef pkgInfoRef $ Just pkgInfo
pure pkgInfo
Nothing -> do
(cabalBlob, mTree) <-
@ -283,7 +284,7 @@ makeCorePackageGetter _compiler pname ver =
getTreeForKey (packageTreeKey (htrPackage htr)))
let gpd = parseCabalBlob cabalBlob
pkgInfo = (mTree, Just hackageCabalId, pid, gpd)
writeIORef pkgInfoRef $ Just pkgInfo
gpd `deepseq` writeIORef pkgInfoRef $ Just pkgInfo
pure pkgInfo
pure $ Just getMemoPackageInfo
where
@ -303,6 +304,7 @@ addPantryPackage sid compiler isHidden flags (PantryPackage pc treeKey) = do
cache = scCacheCabalFiles env
let blobKeyToInt = fromIntegral . unSqlBackendKey . unBlobKey
let updateCacheGPD blobId gpd =
gpd `deepseq`
atomicModifyIORef' gpdCachedRef (\cacheMap -> (IntMap.insert blobId gpd cacheMap, gpd))
let getCachedGPD treeCabal =
\case
@ -400,8 +402,8 @@ checkForDocs snapshotId snapName = do
_ -> pure Nothing
data SnapshotFileInfo = SnapshotFileInfo
{ sfiSnapName :: !SnapName
, sfiUpdatedOn :: !UTCTime
{ sfiSnapName :: !SnapName
, sfiUpdatedOn :: !UTCTime
, sfiSnapshotFileGetter :: !(RIO StackageCron (Maybe SnapshotFile))
}