Merge pull request #1448 from spencerjanssen/test-revisions

Tests for creating/retrieving metadata revisions, remove broken alternative revision path

Author: ysangkok

datafiles/templates/Html/revisions.html.st

@@ -25,7 +25,7 @@ stored separately.
   </tr>
   $revisions:{revision|
     <tr>
-      <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>
+      <td valign="top"><a href="/package/$pkgid$/revision/$revision.number$.cabal">-r$revision.number$</a></td>
       <td valign="top">$revision.htmltime$</td>
       <td valign="top"><a href="/user/$revision.user$">$revision.user$</td>
       <td valign="top">$revision.sha256$</th>

src/Distribution/Server/Features/Core.hs

@@ -226,7 +226,6 @@ data CoreResource = CoreResource {
     corePackageTarball  :: Resource,
     -- | A Cabal file metatada revision.
     coreCabalFileRev    :: Resource,
-    coreCabalFileRevName    :: Resource,
 
     -- Rendering resources.
     -- | URI for `corePackagesPage`, given a format (blank for none).
@@ -405,7 +404,6 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
           , coreCabalFile
           , coreCabalFileRevs
           , coreCabalFileRev
-          , coreCabalFileRevName
           , coreUserDeauth
           , coreAdminDeauth
           , corePackUserDeauth
@@ -459,11 +457,6 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
         resourceDesc = [(GET, "Get package .cabal file revision")]
       , resourceGet  = [("cabal", serveCabalFileRevision)]
       }
-    coreCabalFileRevName = (resourceAt "/package/:package/revision/:tarball-:revision.:format") {
-        resourceDesc = [(GET, "Get package .cabal file revision with name")]
-      , resourceGet  = [("cabal", serveCabalFileRevisionName)]
-      }
-
 
     coreUserDeauth = (resourceAt "/packages/deauth") {
         resourceDesc = [(GET,  "Deauth Package user")]
@@ -761,21 +754,6 @@ coreFeature ServerEnv{serverBlobStore = store} UserFeature{..}
         Nothing -> errNotFound "Package revision not found"
                      [MText "Cannot parse revision, or revision out of range."]
 
-    serveCabalFileRevisionName :: DynamicPath -> ServerPartE Response
-    serveCabalFileRevisionName dpath = do
-      pkgid1 <- packageTarballInPath dpath
-      pkgid2 <- packageInPath dpath
-      guard (pkgVersion pkgid2 == pkgVersion pkgid2)
-      pkginfo <- packageInPath dpath >>= lookupPackageId
-      let mrev      = lookup "revision" dpath >>= fromReqURI
-          revisions = pkgMetadataRevisions pkginfo
-      case mrev >>= \rev -> revisions Vec.!? rev of
-        Just (fileRev, (utime, _uid)) -> return $ toResponse cabalfile
-          where
-            cabalfile = Resource.CabalFile (cabalFileByteString fileRev) utime
-        Nothing -> errNotFound "Package revision not found"
-                     [MText "Cannot parse revision, or revision out of range."]
-
 
     deauth :: DynamicPath -> ServerPartE Response
     deauth _ = do

tests/HighLevelTest.hs

@@ -83,6 +83,7 @@ doit root
          unless (db1 == db2) $ die "Databases don't match"
          info "Checking server still works, and data is intact"
          withServerRunning root runPackageTests
+         withServerRunning root runRevisionTests
 
 
 runUserTests :: IO ()
@@ -191,6 +192,23 @@ runPackageUploadTests = do
     uploadTimeISO = "2010-10-18T20:54:28Z"
     uploadTimeISO2 = "2020-10-18T20:54:28Z"
 
+runRevisionTests :: IO ()
+runRevisionTests = do
+    do info "Revising testpackage"
+       post (Auth "HackageTestUser1" "testpass1") "/package/testpackage-1.0.0.0/testpackage.cabal/edit"
+         [ ("cabalfile", revisedCabalFileContent)
+         , ("publish", "Publish new revision")
+         ]
+    do info "Checking revision exists"
+       xs <- getUrl NoAuth "/package/testpackage-1.0.0.0/revision/1.cabal"
+       unless (xs == revisedCabalFileContent) $
+           die "Bad revised cabal file content"
+  where
+    (_, _, _, testpackageCabalFileContent, _, _) = testpackage
+    revisedCabalFileContent =
+      "x-revision: 1\ndescription: a description added by revision\n"
+         ++ testpackageCabalFileContent
+
 runPackageTests :: IO ()
 runPackageTests = do
     do info "Getting package list"