haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-25 10:21:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge pull request #268 from lehins/fix-leak-and-latest-hackage

Browse Source 
Two minor fixups
This commit is contained in:
Michael Snoyman 2019-06-26 12:42:02 +03:00 committed by GitHub
commit ebdde64745
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
2 changed files with 8 additions and 8 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 ) where
import Conduit import Conduit
import Control.DeepSeq
import Control.Lens ((.~)) import Control.Lens ((.~))
import qualified Control.Monad.Trans.AWS as AWS (paginate) import qualified Control.Monad.Trans.AWS as AWS (paginate)
import Control.SingleRun import Control.SingleRun
@ -274,7 +275,7 @@ makeCorePackageGetter _compiler pname ver =
Just (gpd, treeId) -> do Just (gpd, treeId) -> do
mTree <- run $ getEntity treeId mTree <- run $ getEntity treeId
let pkgInfo = (mTree, Just hackageCabalId, pid, gpd) let pkgInfo = (mTree, Just hackageCabalId, pid, gpd)
writeIORef pkgInfoRef $ Just pkgInfo gpd `deepseq` writeIORef pkgInfoRef $ Just pkgInfo
pure pkgInfo pure pkgInfo
Nothing -> do Nothing -> do
(cabalBlob, mTree) <- (cabalBlob, mTree) <-
@ -283,7 +284,7 @@ makeCorePackageGetter _compiler pname ver =
getTreeForKey (packageTreeKey (htrPackage htr))) getTreeForKey (packageTreeKey (htrPackage htr)))
let gpd = parseCabalBlob cabalBlob let gpd = parseCabalBlob cabalBlob
pkgInfo = (mTree, Just hackageCabalId, pid, gpd) pkgInfo = (mTree, Just hackageCabalId, pid, gpd)
writeIORef pkgInfoRef $ Just pkgInfo gpd `deepseq` writeIORef pkgInfoRef $ Just pkgInfo
pure pkgInfo pure pkgInfo
pure $ Just getMemoPackageInfo pure $ Just getMemoPackageInfo
where where
@ -303,6 +304,7 @@ addPantryPackage sid compiler isHidden flags (PantryPackage pc treeKey) = do
cache = scCacheCabalFiles env cache = scCacheCabalFiles env
let blobKeyToInt = fromIntegral . unSqlBackendKey . unBlobKey let blobKeyToInt = fromIntegral . unSqlBackendKey . unBlobKey
let updateCacheGPD blobId gpd = let updateCacheGPD blobId gpd =
gpd `deepseq`
atomicModifyIORef' gpdCachedRef (\cacheMap -> (IntMap.insert blobId gpd cacheMap, gpd)) atomicModifyIORef' gpdCachedRef (\cacheMap -> (IntMap.insert blobId gpd cacheMap, gpd))
let getCachedGPD treeCabal = let getCachedGPD treeCabal =
\case \case
@ -400,8 +402,8 @@ checkForDocs snapshotId snapName = do
_ -> pure Nothing _ -> pure Nothing
data SnapshotFileInfo = SnapshotFileInfo data SnapshotFileInfo = SnapshotFileInfo
{ sfiSnapName :: !SnapName { sfiSnapName :: !SnapName
, sfiUpdatedOn :: !UTCTime , sfiUpdatedOn :: !UTCTime
, sfiSnapshotFileGetter :: !(RIO StackageCron (Maybe SnapshotFile)) , sfiSnapshotFileGetter :: !(RIO StackageCron (Maybe SnapshotFile))
} }

6
src/Stackage/Database/Query.hs
View File

@ -440,10 +440,8 @@ getSnapshotPackagePageInfo ::
GetStackageDatabase env m => SnapshotPackageInfo -> Int -> m SnapshotPackagePageInfo GetStackageDatabase env m => SnapshotPackageInfo -> Int -> m SnapshotPackagePageInfo
getSnapshotPackagePageInfo spi maxDisplayedDeps = getSnapshotPackagePageInfo spi maxDisplayedDeps =
run $ do run $ do
mhciLatest <- mhciLatest <- getHackageLatestVersion $ spiPackageName spi
case spiOrigin spi of -- TODO: check for `spiOrigin spi` once other than `Hackage` are implemented
Hackage -> getHackageLatestVersion $ spiPackageName spi
_ -> pure Nothing
forwardDepsCount <- getForwardDepsCount spi forwardDepsCount <- getForwardDepsCount spi
reverseDepsCount <- getReverseDepsCount spi reverseDepsCount <- getReverseDepsCount spi
forwardDeps <- forwardDeps <-