Skip to content

Commit 22b5612

Browse files
authored
Merge pull request #1262 from lockywolf/master
Allow serving cabal files with package name in the file name.
2 parents 4a14eaf + 113d4df commit 22b5612

File tree

2 files changed

+23
-1
lines changed

2 files changed

+23
-1
lines changed

datafiles/templates/Html/revisions.html.st

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,7 @@ stored separately.
2525
</tr>
2626
$revisions:{revision|
2727
<tr>
28-
<td valign="top"><a href="/package/$pkgid$/revision/$revision.number$.cabal">-r$revision.number$</a></td>
28+
<td valign="top"><a href="/package/$pkgid$/revision/$revision.number$.cabal">-r$revision.number$</a> (<a href="/package/$pkgid$/revision/$pkgid$-$revision.number$.cabal">$pkgid$-r$revision.number$</a>)</td>
2929
<td valign="top">$revision.htmltime$</td>
3030
<td valign="top"><a href="/user/$revision.user$">$revision.user$</td>
3131
<td valign="top">$revision.sha256$</th>

src/Distribution/Server/Features/Core.hs

Lines changed: 22 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -226,6 +226,7 @@ data CoreResource = CoreResource {
226226
corePackageTarball :: Resource,
227227
-- | A Cabal file metatada revision.
228228
coreCabalFileRev :: Resource,
229+
coreCabalFileRevName :: Resource,
229230

230231
-- Rendering resources.
231232
-- | URI for `corePackagesPage`, given a format (blank for none).
@@ -404,6 +405,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
404405
, coreCabalFile
405406
, coreCabalFileRevs
406407
, coreCabalFileRev
408+
, coreCabalFileRevName
407409
, coreUserDeauth
408410
, coreAdminDeauth
409411
, corePackUserDeauth
@@ -457,6 +459,11 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
457459
resourceDesc = [(GET, "Get package .cabal file revision")]
458460
, resourceGet = [("cabal", serveCabalFileRevision)]
459461
}
462+
coreCabalFileRevName = (resourceAt "/package/:package/revision/:tarball-:revision.:format") {
463+
resourceDesc = [(GET, "Get package .cabal file revision with name")]
464+
, resourceGet = [("cabal", serveCabalFileRevisionName)]
465+
}
466+
460467

461468
coreUserDeauth = (resourceAt "/packages/deauth") {
462469
resourceDesc = [(GET, "Deauth Package user")]
@@ -754,6 +761,21 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
754761
Nothing -> errNotFound "Package revision not found"
755762
[MText "Cannot parse revision, or revision out of range."]
756763

764+
serveCabalFileRevisionName :: DynamicPath -> ServerPartE Response
765+
serveCabalFileRevisionName dpath = do
766+
pkgid1 <- packageTarballInPath dpath
767+
pkgid2 <- packageInPath dpath
768+
guard (pkgVersion pkgid2 == pkgVersion pkgid2)
769+
pkginfo <- packageInPath dpath >>= lookupPackageId
770+
let mrev = lookup "revision" dpath >>= fromReqURI
771+
revisions = pkgMetadataRevisions pkginfo
772+
case mrev >>= \rev -> revisions Vec.!? rev of
773+
Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
774+
where
775+
cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
776+
Nothing -> errNotFound "Package revision not found"
777+
[MText "Cannot parse revision, or revision out of range."]
778+
757779

758780
deauth :: DynamicPath -> ServerPartE Response
759781
deauth _ = do

0 commit comments

Comments
 (0)