Cabal 3.4: CabalSpecVersion (#1016)

The `cabal-version` field now gets parsed into an enum type,
`CabalSpecVersion`, rather than `Version` (`Int` list).

Some of the checks in `D.Server.Packages.Unpack.specVersionChecks`
seem non-sensical now or outdated (do not mention cabal version 3 or
higher).
In this patch, I just mechanically ported this code to
`CabalSpecVersion`, needs review.

Author: andreasabel

src/Distribution/Server/Packages/Index.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE BangPatterns, TemplateHaskell #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE PatternSynonyms #-}  -- for importing constructors
+{-# LANGUAGE TemplateHaskell #-}
+
 module Distribution.Server.Packages.Index (
     writeIncremental,
     TarIndexEntry(..),
@@ -30,7 +33,8 @@ import Distribution.Text
 import Distribution.Types.PackageName
 import Distribution.Package
          ( Package, PackageId, packageName, packageVersion )
-import Distribution.Version (mkVersion)
+import Distribution.CabalSpecVersion
+         ( pattern CabalSpecV2_0 )
 import Data.Time.Clock
          ( UTCTime )
 import Data.Time.Clock.POSIX
@@ -218,7 +222,7 @@ writeLegacyAux externalPackageRep updateEntry extras =
   where
     -- entry :: pkg -> Maybe Tar.Entry
     entry pkg
-      | specVer >= mkVersion [2] = Nothing
+      | specVerGEq2              = Nothing
       | otherwise                = Just
                                  . updateEntry pkg
                                  . Tar.fileEntry tarPath
@@ -230,5 +234,5 @@ writeLegacyAux externalPackageRep updateEntry extras =
                         </> name <.> "cabal"
 
         -- TODO: Hack-alert! We want to do this in a more elegant way.
-        specVer = parseSpecVerLazy cabalText
+        specVerGEq2 = maybe False (>= CabalSpecV2_0) $ parseSpecVerLazy cabalText
         cabalText = externalPackageRep pkg

src/Distribution/Server/Packages/Unpack.hs

@@ -17,8 +17,10 @@ import qualified Codec.Archive.Tar       as Tar
 import qualified Codec.Archive.Tar.Entry as Tar
 import qualified Codec.Archive.Tar.Check as Tar
 
+import Distribution.CabalSpecVersion
+         ( CabalSpecVersion(..), showCabalSpecVersion )
 import Distribution.Version
-         ( Version, nullVersion, mkVersion )
+         ( nullVersion )
 import Distribution.Types.PackageName
          ( mkPackageName, unPackageName )
 import Distribution.Package
@@ -196,30 +198,34 @@ basicChecks pkgid tarIndex = do
     -- special meaning in cabal's UI
     reservedPkgNames = map mkPackageName ["all","any","none","setup","lib","exe","test"]
 
-specVersionChecks :: MonadError String m => Bool -> Version -> m ()
+specVersionChecks :: MonadError String m => Bool -> CabalSpecVersion -> m ()
 specVersionChecks specVerOk specVer = do
-  when (not specVerOk || specVer < mkVersion [1]) $
+  when (not specVerOk) $
     throwError "The 'cabal-version' field could not be properly parsed."
 
   -- Don't allowing uploading new pre-1.2 .cabal files as the parser is likely too lax
   -- TODO: slowly phase out ancient cabal spec versions below 1.10
-  when (specVer < mkVersion [1,2]) $
+  when (specVer < CabalSpecV1_2) $
     throwError "'cabal-version' must be at least 1.2"
 
-  -- Reject not well-defined cabal spec versions on upload
-  when (specVer >= mkVersion [1,25] && specVer < mkVersion [2]) $
-    throwError "'cabal-version' in unassigned >=1.25 && <2 range; use 'cabal-version: 2.0' instead"
-
   -- Safeguard; should already be caught by parser
-  unless (specVer < mkVersion [2,5]) $
-    throwError "'cabal-version' must be lower than 2.5"
+  unless (specVer <= CabalSpecV2_4) $
+    throwError "'cabal-version' must be at most 2.4"
 
   -- Check whether a known spec version had been used
   -- TODO: move this into lib:Cabal
-  let knownSpecVersions = map mkVersion [ [1,18], [1,20], [1,22], [1,24], [2,0], [2,2], [2,4] ]
-  when (specVer >= mkVersion [1,18] && (specVer `notElem` knownSpecVersions)) $
+  let knownSpecVersions =
+        [ CabalSpecV1_18
+        , CabalSpecV1_20
+        , CabalSpecV1_22
+        , CabalSpecV1_24
+        , CabalSpecV2_0
+        , CabalSpecV2_2
+        , CabalSpecV2_4
+        ]
+  when (specVer >= CabalSpecV1_18 && (specVer `notElem` knownSpecVersions)) $
     throwError ("'cabal-version' refers to an unreleased/unknown cabal specification version "
-                ++ display specVer ++ "; for a list of valid specification versions please consult "
+                ++ showCabalSpecVersion specVer ++ "; for a list of valid specification versions please consult "
                 ++ "https://www.haskell.org/cabal/users-guide/file-format-changelog.html")
 
 -- | The issue is that browsers can upload the file name using either unix

src/Distribution/Server/Util/ParseSpecVer.hs

@@ -19,6 +19,7 @@ import qualified Data.ByteString.Lazy  as BSL
 import qualified Data.ByteString.Lazy.Char8 as BC8L
 import           Data.List.NonEmpty  ( toList)
 import           Distribution.Text
+import           Distribution.CabalSpecVersion
 import           Distribution.Pretty ( prettyShow )
 import           Distribution.Parsec ( PWarning, PError )
 import           Distribution.Version
@@ -45,22 +46,25 @@ import           Distribution.PackageDescription.Parsec ( runParseResult, parseG
 -- inferred 'specVersion'. IOW, Hackage ensures on upload that only
 -- @.cabal@ files are accepted which support the heuristic parsing.
 --
--- If no valid version field can be found, @mkVersion [0]@ is returned.
-parseSpecVer :: ByteString -> Version
-parseSpecVer = maybe (mkVersion [0]) id . findCabVer
+-- If no valid version field can be found, @Nothing@ is returned.
+parseSpecVer :: ByteString -> Maybe CabalSpecVersion
+parseSpecVer = findCabVer
 
-parseSpecVerLazy :: BSL.ByteString -> Version
+parseSpecVerLazy :: BSL.ByteString -> Maybe CabalSpecVersion
 parseSpecVerLazy = parseSpecVer . BSL.toStrict
 
+versionToCabalSpecVersion :: Version -> Maybe CabalSpecVersion
+versionToCabalSpecVersion = cabalSpecFromVersionDigits . versionNumbers
+
 isWS :: Word8 -> Bool
 isWS = (`elem` [0x20,0x09])
 
 eatWS :: ByteString -> ByteString
 eatWS = BS.dropWhile isWS
 
 -- | Try to heuristically locate & parse a 'cabal-version' field
-findCabVer :: ByteString -> Maybe Version
-findCabVer raw = msum [ decodeVer y | (_,_,y) <- findCabVers raw ]
+findCabVer :: ByteString -> Maybe CabalSpecVersion
+findCabVer raw = msum [ versionToCabalSpecVersion =<< decodeVer y | (_,_,y) <- findCabVers raw ]
 
 -- | Return list of @cabal-version@ candidates as 3-tuples of
 -- (prefix,indentation-level,value-words) in reverse order of
@@ -282,16 +286,17 @@ scanSpecVersionLazy bs = do
 -- * Starting with cabal-version:2.2 'scanSpecVersionLazy' must succeed
 --
 -- 'True' is returned in the first element if sanity checks passes.
-parseGenericPackageDescriptionChecked :: BSL.ByteString -> (Bool,[PWarning], Either (Maybe Version, [PError]) GenericPackageDescription)
+parseGenericPackageDescriptionChecked :: BSL.ByteString -> (Bool, [PWarning], Either (Maybe Version, [PError]) GenericPackageDescription)
 parseGenericPackageDescriptionChecked bs = case parseGenericPackageDescription' bs of
    (warns, Left pe) -> (False, warns, Left $ fmap toList pe)
-   (warns, Right gpd)   -> (isOk (specVersion (packageDescription gpd)),warns, Right gpd)
+   (warns, Right gpd) -> (isOk (specVersion (packageDescription gpd)), warns, Right gpd)
  where
-   isOk :: Version -> Bool
+   isOk :: CabalSpecVersion -> Bool
    isOk v
-     | v /= parseSpecVerLazy bs           = False
-     | Just v' <- scanSpecVersionLazy bs  = v == v'
-     | otherwise                          = v < mkVersion [2,3]
+     | Just v /= parseSpecVerLazy bs      = False
+     | Just v' <- versionToCabalSpecVersion =<< scanSpecVersionLazy bs
+                                          = v == v'
+     | otherwise                          = v <= CabalSpecV2_2
 
 #if defined(MIN_VERSION_cabal_parsers)
    parseGenericPackageDescription' bs' = compatParseGenericPackageDescription (BSL.toStrict bs')

tests/PackageTestMain.hs

@@ -78,7 +78,7 @@ badSpecVer =
        Left err ->
          HUnit.assertBool
            ("Error found, but not about invalid spec version: " ++ err)
-           ("cabal-version" `isInfixOf` err)
+           ("cabal spec version" `isInfixOf` err)
 
 -- | Some tar files in hackage are missing directory entries.
 -- Ensure that they can be verified even without the directory entries.