haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-11 19:58:28 +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

46
Handler/StackageHome.hs
View File

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

6
templates/stackage-home.hamlet
View File

@ -37,6 +37,12 @@ $newline never
<div .container .content>
<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>
<thead>
<th>Package