Skip to content

Commit 113d4df

Browse files
author
Vladimir Nikishkin
committed
Allow serving cabal files with package name in the file name.
Allow serving url like this: https://hackage.haskell.org/package/pkg-2.6/revision/pkg-2.6-1.cabal
1 parent 458fb77 commit 113d4df

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
@@ -225,6 +225,7 @@ data CoreResource = CoreResource {
225225
corePackageTarball :: Resource,
226226
-- | A Cabal file metatada revision.
227227
coreCabalFileRev :: Resource,
228+
coreCabalFileRevName :: Resource,
228229

229230
-- Rendering resources.
230231
-- | URI for `corePackagesPage`, given a format (blank for none).
@@ -403,6 +404,7 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
403404
, coreCabalFile
404405
, coreCabalFileRevs
405406
, coreCabalFileRev
407+
, coreCabalFileRevName
406408
, coreUserDeauth
407409
, coreAdminDeauth
408410
, corePackUserDeauth
@@ -456,6 +458,11 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
456458
resourceDesc = [(GET, "Get package .cabal file revision")]
457459
, resourceGet = [("cabal", serveCabalFileRevision)]
458460
}
461+
coreCabalFileRevName = (resourceAt "/package/:package/revision/:tarball-:revision.:format") {
462+
resourceDesc = [(GET, "Get package .cabal file revision with name")]
463+
, resourceGet = [("cabal", serveCabalFileRevisionName)]
464+
}
465+
459466

460467
coreUserDeauth = (resourceAt "/packages/deauth") {
461468
resourceDesc = [(GET, "Deauth Package user")]
@@ -750,6 +757,21 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
750757
Nothing -> errNotFound "Package revision not found"
751758
[MText "Cannot parse revision, or revision out of range."]
752759

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

754776
deauth :: DynamicPath -> ServerPartE Response
755777
deauth _ = do

0 commit comments

Comments
 (0)