Remove cabal-version:>=2.0 entries from legacy 00-index

The new cabal-version:2.0 format introduces new syntax
but unfortunately confuses old cabal-install versions.

On the bright side, versions prior to cabal-1.24 only support
the 00-index legacy index. While cabal-1.24 uses the 00-index
by default (users have to opt into secure repositores in order
to access the new 01-index). Since old cabal versions
can't deal with cabal-version:2.0 entries anyway, there's no
harm in hiding them in the legacy index.

So with this server-side workaround we should be able to
mitigate the issue for the majority of the legacy-user base.

The implementation of this workaround is not very principled,
but due to the urgency, it'll have to be refactored some time
later...

Distribution/Server/Features/EditCabalFiles.hs

@@ -17,7 +17,14 @@ import Distribution.Server.Features.Upload
 
 import Distribution.Package
 import Distribution.Text (display)
+import Distribution.ParseUtils
+         ( ParseResult(..), locatedErrorMsg )
+import Distribution.PackageDescription
+         ( GenericPackageDescription(..), specVersion )
+import Distribution.PackageDescription.Parse
+         ( parseGenericPackageDescription )
 import Distribution.Server.Util.Parse (unpackUTF8)
+import Distribution.Server.Util.ParseSpecVer
 import Distribution.Server.Util.CabalRevisions
          (Change(..), diffCabalRevisions, insertRevisionField)
 import Text.StringTemplate (ToSElem(..))
@@ -142,7 +149,29 @@ editCabalFilesFeature _env templates
 -- stripped.
 diffCabalRevisionsByteString :: ByteString -> ByteString -> Either String [Change]
 diffCabalRevisionsByteString oldRevision newRevision =
-    diffCabalRevisions (unpackUTF8 oldRevision) (unpackUTF8 newRevision)
+    maybe (diffCabalRevisions (unpackUTF8 oldRevision) newRevision')
+          Left
+          parseSpecVerCheck
+  where
+    newRevision' = unpackUTF8 newRevision
+
+    -- HACK-Alert
+    --
+    -- make sure the parseSpecVer heuristic agrees with the full parser.
+    -- Note that diffCabalRevisions parses the newRevision a second time.
+    parseSpecVerCheck = case parseGenericPackageDescription newRevision' of
+       ParseFailed err -> Just $ showError (locatedErrorMsg err)
+       ParseOk _warnings pd
+         | specVersion (packageDescription pd) /= specVer'
+            -> Just "The 'cabal-version' field could not be properly parsed"
+         | otherwise -> Nothing
+      where
+        specVer' = parseSpecVerLazy newRevision
+
+
+    showError (Nothing, msg) = msg
+    showError (Just n, msg) = "line " ++ show n ++ ": " ++ msg
+
 
 -- orphan
 instance ToSElem Change where

Distribution/Server/Packages/Index.hs

@@ -23,12 +23,14 @@ import Distribution.Server.Users.Users
          ( Users, userIdToName )
 import Distribution.Server.Users.Types
          ( UserName(..) )
+import Distribution.Server.Util.ParseSpecVer
 
 import Distribution.Text
          ( display )
 import Distribution.Types.PackageName
 import Distribution.Package
          ( Package, PackageId, packageName, packageVersion )
+import Distribution.Version (mkVersion)
 import Data.Time.Clock
          ( UTCTime )
 import Data.Time.Clock.POSIX
@@ -41,7 +43,7 @@ import qualified Data.Map as Map
 import qualified Data.Vector as Vec
 import Data.ByteString.Lazy (ByteString)
 import System.FilePath.Posix
-import Data.Maybe (catMaybes)
+import Data.Maybe (catMaybes, mapMaybe)
 
 
 -- | Entries used to construct the contents of the hackage index tarball
@@ -187,6 +189,8 @@ writeLegacy users =
       }
 
     userName = display . userIdToName users
+
+    extraEntries :: Map FilePath (ByteString, UTCTime) -> [Tar.Entry]
     extraEntries emap = do
         (path, (entry, mtime)) <- Map.toList emap
         Right tarPath <- return $ Tar.toTarPath False path
@@ -198,20 +202,33 @@ writeLegacy users =
 -- entries are also accepted.
 --
 -- This used to live in Distribution.Server.Util.Index.
+--
+-- NOTE: In order to mitigate the effects of
+--       https://github.com/haskell/cabal/issues/4624
+--       as a hack, this operation filters out .cabal files
+--       with cabal-version >= 2.
 writeLegacyAux :: Package pkg
                => (pkg -> ByteString)
                -> (pkg -> Tar.Entry -> Tar.Entry)
                -> [Tar.Entry]
                -> PackageIndex pkg
                -> ByteString
 writeLegacyAux externalPackageRep updateEntry extras =
-  Tar.write . (extras++) . map entry . PackageIndex.allPackages
+  Tar.write . (extras++) . mapMaybe entry . PackageIndex.allPackages
   where
-    entry pkg = updateEntry pkg
-              . Tar.fileEntry tarPath
-              $ externalPackageRep pkg
+    -- entry :: pkg -> Maybe Tar.Entry
+    entry pkg
+      | specVer >= mkVersion [2] = Nothing
+      | otherwise                = Just
+                                 . updateEntry pkg
+                                 . Tar.fileEntry tarPath
+                                 $ cabalText
       where
         Right tarPath = Tar.toTarPath False fileName
         name = unPackageName $ packageName pkg
         fileName = name </> display (packageVersion pkg)
                         </> name <.> "cabal"
+
+        -- TODO: Hack-alert! We want to do this in a more elegant way.
+        specVer = parseSpecVerLazy cabalText
+        cabalText = externalPackageRep pkg

Distribution/Server/Packages/Unpack.hs

@@ -16,15 +16,15 @@ import qualified Codec.Archive.Tar.Entry as Tar
 import qualified Codec.Archive.Tar.Check as Tar
 
 import Distribution.Version
-         ( nullVersion )
+         ( nullVersion, mkVersion )
 import Distribution.Types.PackageName
          ( mkPackageName, unPackageName )
 import Distribution.Package
          ( PackageIdentifier, packageVersion, packageName, PackageName )
 import Distribution.PackageDescription
          ( GenericPackageDescription(..), PackageDescription(..)
          , allBuildInfo, allLibraries
-         , exposedModules, mixins, signatures
+         , exposedModules, mixins, signatures, specVersion
          )
 import Distribution.PackageDescription.Parse
          ( parsePackageDescription )
@@ -41,6 +41,7 @@ import Distribution.ModuleName
          ( components )
 import Distribution.Server.Util.Parse
          ( unpackUTF8 )
+import Distribution.Server.Util.ParseSpecVer
 import Distribution.License
          ( License(..) )
 import qualified Distribution.Compat.ReadP as Parse
@@ -206,6 +207,13 @@ basicChecks pkgid tarIndex = do
     ParseOk warnings pkgDesc ->
       return (pkgDesc, map (showPWarning cabalFileName) warnings)
 
+  -- make sure the parseSpecVer heuristic agrees with the full parser
+  let specVer' = parseSpecVerLazy cabalEntry
+      specVer  = specVersion $ packageDescription pkgDesc
+
+  when (specVer' < mkVersion [1] || specVer /= specVer') $
+    throwError "The 'cabal-version' field could not be properly parsed."
+
   -- Check that the name and version in Cabal file match
   when (packageName pkgDesc /= packageName pkgid) $
     throwError "Package name in the cabal file does not match the file name."