haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-19 22:35:47 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Clip package list to 5000 to avoid memory exhaustion

Browse Source
This commit is contained in:
Michael Snoyman 2014-12-19 10:12:55 +02:00
parent 3d36e2dc28
commit d8925a9fed
2 changed files with 32 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
Handler/StackageHome.hs
View File

@ -25,7 +25,9 @@ getStackageHomeR slug = do
defaultLayout $ do defaultLayout $ do
setTitle $ toHtml $ stackageTitle stackage setTitle $ toHtml $ stackageTitle stackage
cachedWidget (20 * 60) ("package-list-" ++ toPathPiece slug) $ do cachedWidget (20 * 60) ("package-list-" ++ toPathPiece slug) $ do
packages' <- handlerToWidget $ runDB $ E.select $ E.from $ \(u,m,p) -> do let maxPackages = 5000
(packageListClipped, packages') <- handlerToWidget $ runDB $ do
packages' <- E.select $ E.from $ \(u,m,p) -> do
E.where_ $ E.where_ $
(m E.^. MetadataName E.==. u E.^. UploadedName) E.&&. (m E.^. MetadataName E.==. u E.^. UploadedName) E.&&.
(m E.^. MetadataName E.==. p E.^. PackageName') E.&&. (m E.^. MetadataName E.==. p E.^. PackageName') E.&&.
@ -34,6 +36,7 @@ getStackageHomeR slug = do
E.groupBy ( u E.^. UploadedName E.groupBy ( u E.^. UploadedName
, m E.^. MetadataSynopsis , m E.^. MetadataSynopsis
) )
E.limit maxPackages
return return
( u E.^. UploadedName ( u E.^. UploadedName
, m E.^. MetadataSynopsis , m E.^. MetadataSynopsis
@ -45,6 +48,9 @@ getStackageHomeR slug = do
] ]
(E.val (Version "")) (E.val (Version ""))
) )
packageCount <- count [PackageStackage ==. sid]
let packageListClipped = packageCount > maxPackages
return (packageListClipped, packages')
let packages = flip map packages' $ \(name, syn, latestVersion, forceNotNull -> mversion) -> let packages = flip map packages' $ \(name, syn, latestVersion, forceNotNull -> mversion) ->
( E.unValue name ( E.unValue name
, fmap unVersion $ E.unValue latestVersion , fmap unVersion $ E.unValue latestVersion

6
templates/stackage-home.hamlet
View File

@ -37,6 +37,12 @@ $newline never
<div .container .content> <div .container .content>
<div .packages> <div .packages>
$if packageListClipped
<p>
Note: due to a large number of packages, not all packages are display.
For a full listing, please see #
<a href=@{SnapshotR slug StackageMetadataR}>the metadata listing
.
<table .table> <table .table>
<thead> <thead>
<th>Package <th>Package