Merge pull request haskell#10647 from MercuryTechnologies/improve-tar-errors

Improve "Cannot read .cabal file inside ..." errors

Author: mergify[bot]

cabal-install/src/Distribution/Client/Errors.hs

@@ -70,7 +70,7 @@ data CabalInstallException
   | ReportTargetProblems String
   | ListBinTargetException String
   | ResolveWithoutDependency String
-  | CannotReadCabalFile FilePath
+  | CannotReadCabalFile FilePath FilePath
   | ErrorUpdatingIndex FilePath IOException
   | InternalError FilePath
   | ReadIndexCache FilePath
@@ -390,7 +390,11 @@ exceptionMessageCabalInstall e = case e of
   ReportTargetProblems problemsMsg -> problemsMsg
   ListBinTargetException errorStr -> errorStr
   ResolveWithoutDependency errorStr -> errorStr
-  CannotReadCabalFile file -> "Cannot read .cabal file inside " ++ file
+  CannotReadCabalFile expect file ->
+    "Failed to read "
+      ++ expect
+      ++ " from archive "
+      ++ file
   ErrorUpdatingIndex name ioe -> "Error while updating index for " ++ name ++ " repository " ++ show ioe
   InternalError msg ->
     "internal error when reading package index: "

cabal-install/src/Distribution/Client/IndexUtils.hs

@@ -66,6 +66,10 @@ import Distribution.Client.Types
 import Distribution.Parsec (simpleParsecBS)
 import Distribution.Verbosity
 
+import Distribution.Client.ProjectConfig
+  ( CabalFileParseError
+  , readSourcePackageCabalFile'
+  )
 import Distribution.Client.Setup
   ( RepoContext (..)
   )
@@ -97,6 +101,7 @@ import Distribution.Simple.Utils
   , fromUTF8LBS
   , info
   , warn
+  , warnError
   )
 import Distribution.Types.Dependency
 import Distribution.Types.PackageName (PackageName)
@@ -880,14 +885,22 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam
         where
           cabalPath = prettyShow pkgid ++ ".cabal"
       Just pkgId -> do
+        let tarFile = localDir </> file
         -- check for the right named .cabal file in the compressed tarball
-        tarGz <- BS.readFile (localDir </> file)
+        tarGz <- BS.readFile tarFile
         let tar = GZip.decompress tarGz
             entries = Tar.read tar
+            expectFilename = prettyShow pkgId FilePath.</> prettyShow (packageName pkgId) ++ ".cabal"
 
-        case Tar.foldEntries (readCabalEntry pkgId) Nothing (const Nothing) entries of
+        tarballPackageDescription <-
+          Tar.foldEntries
+            (readCabalEntry tarFile expectFilename)
+            (pure Nothing)
+            (handleTarFormatError tarFile)
+            entries
+        case tarballPackageDescription of
           Just ce -> return (Just ce)
-          Nothing -> dieWithException verbosity $ CannotReadCabalFile file
+          Nothing -> dieWithException verbosity $ CannotReadCabalFile expectFilename tarFile
 
   let (prefs, gpds) =
         partitionEithers $
@@ -918,16 +931,55 @@ withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo nam
 
     stripSuffix sfx str = fmap reverse (stripPrefix (reverse sfx) (reverse str))
 
-    -- look for <pkgid>/<pkgname>.cabal inside the tarball
-    readCabalEntry :: PackageIdentifier -> Tar.Entry -> Maybe NoIndexCacheEntry -> Maybe NoIndexCacheEntry
-    readCabalEntry pkgId entry Nothing
-      | filename == Tar.entryPath entry
-      , Tar.NormalFile contents _ <- Tar.entryContent entry =
-          let bs = BS.toStrict contents
-           in ((`CacheGPD` bs) <$> parseGenericPackageDescriptionMaybe bs)
-      where
-        filename = prettyShow pkgId FilePath.</> prettyShow (packageName pkgId) ++ ".cabal"
-    readCabalEntry _ _ x = x
+    handleTarFormatError :: FilePath -> Tar.FormatError -> IO (Maybe NoIndexCacheEntry)
+    handleTarFormatError tarFile formatError = do
+      -- This is printed at warning-level because malformed `.tar.gz`s in
+      -- indexes are unexpected and we want users to tell us about them.
+      warnError verbosity $
+        "Failed to parse "
+          <> tarFile
+          <> ": "
+          <> displayException formatError
+      pure Nothing
+
+    -- look for `expectFilename` inside the tarball
+    readCabalEntry
+      :: FilePath
+      -> FilePath
+      -> Tar.Entry
+      -> IO (Maybe NoIndexCacheEntry)
+      -> IO (Maybe NoIndexCacheEntry)
+    readCabalEntry tarFile expectFilename entry previous' = do
+      previous <- previous'
+      case previous of
+        Just _entry -> pure previous
+        Nothing -> do
+          if expectFilename /= Tar.entryPath entry
+            then pure Nothing
+            else case Tar.entryContent entry of
+              Tar.NormalFile contents _fileSize -> do
+                let bytes = BS.toStrict contents
+                maybePackageDescription
+                  :: Either CabalFileParseError GenericPackageDescription <-
+                  -- Warnings while parsing `.cabal` files are only shown in
+                  -- verbose mode because people are allowed to upload packages
+                  -- with warnings to Hackage (and we may _add_ warnings by
+                  -- shipping new versions of Cabal). You probably don't care
+                  -- if there's a warning in some random package in your
+                  -- transitive dependency tree, as long as it's not causing
+                  -- issues. If it is causing issues, you can add `-v` to see
+                  -- the warnings!
+                  try $ readSourcePackageCabalFile' (info verbosity) expectFilename bytes
+                case maybePackageDescription of
+                  Left exception -> do
+                    -- Here we show the _failure_ to parse the `.cabal` file as
+                    -- a warning. This will impact which versions/packages are
+                    -- available in your index, so users should know!
+                    warn verbosity $ "In " <> tarFile <> ": " <> displayException exception
+                    pure Nothing
+                  Right genericPackageDescription ->
+                    pure $ Just $ CacheGPD genericPackageDescription bytes
+              _ -> pure Nothing
 withIndexEntries verbosity index callback _ = do
   -- non-secure repositories
   withFile (indexFile index) ReadMode $ \h -> do

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -37,6 +37,9 @@ module Distribution.Client.ProjectConfig
   , writeProjectConfigFile
   , commandLineFlagsToProjectConfig
   , onlyTopLevelProvenance
+  , readSourcePackageCabalFile
+  , readSourcePackageCabalFile'
+  , CabalFileParseError (..)
 
     -- * Packages within projects
   , ProjectPackageLocation (..)
@@ -173,7 +176,6 @@ import Distribution.Simple.Setup
 import Distribution.Simple.Utils
   ( createDirectoryIfMissingVerbose
   , dieWithException
-  , info
   , maybeExit
   , notice
   , rawSystemIOWithEnv
@@ -1610,10 +1612,22 @@ readSourcePackageCabalFile
   -> BS.ByteString
   -> IO GenericPackageDescription
 readSourcePackageCabalFile verbosity pkgfilename content =
+  readSourcePackageCabalFile' (warn verbosity) pkgfilename content
+
+-- | Like `readSourcePackageCabalFile`, but the `warn` function is an argument.
+--
+-- This is used when reading @.cabal@ files in indexes, where warnings should
+-- generally be ignored.
+readSourcePackageCabalFile'
+  :: (String -> IO ())
+  -> FilePath
+  -> BS.ByteString
+  -> IO GenericPackageDescription
+readSourcePackageCabalFile' logWarnings pkgfilename content =
   case runParseResult (parseGenericPackageDescription content) of
     (warnings, Right pkg) -> do
       unless (null warnings) $
-        info verbosity (formatWarnings warnings)
+        logWarnings (formatWarnings warnings)
       return pkg
     (warnings, Left (mspecVersion, errors)) ->
       throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings

cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/pkg/pkg.cabal

@@ -1,7 +1,7 @@
 name: pkg
 version: 1.0
 build-type: Custom
-cabal-version: >= 1.20
+cabal-version: 1.20
 
 custom-setup
   setup-depends: base, Cabal, setup-dep == 2.*

cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/repo/setup-dep-1.0/setup-dep.cabal

@@ -1,7 +1,7 @@
 name: setup-dep
 version: 1.0
 build-type: Simple
-cabal-version: >= 1.20
+cabal-version: 1.20
 
 library
   build-depends: base

cabal-testsuite/PackageTests/BuildTargets/UseLocalPackageForSetup/setup-dep/setup-dep.cabal

@@ -1,7 +1,7 @@
 name: setup-dep
 version: 2.0
 build-type: Simple
-cabal-version: >= 1.20
+cabal-version: 1.20
 
 library
   build-depends: base

cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out

@@ -0,0 +1,19 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+Warning: In <ROOT>/cabal.dist/repo/my-lib-1.0.tar.gz: Errors encountered when parsing cabal file my-lib-1.0/my-lib.cabal:
+
+my-lib-1.0/my-lib.cabal:4:22: error:
+unexpected Unknown SPDX license identifier: 'puppy' 
+
+    3 | version:        1.0
+    4 | license:        puppy license :)
+      |                      ^
+
+my-lib-1.0/my-lib.cabal:5:1: warning:
+Unknown field: "puppy"
+
+    4 | license:        puppy license :)
+    5 | puppy:          teehee!
+      | ^
+Error: [Cabal-7046]
+Failed to read my-lib-1.0/my-lib.cabal from archive <ROOT>/cabal.dist/repo/my-lib-1.0.tar.gz

cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.test.hs

@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+
+main = cabalTest $ withRepoNoUpdate "repo" $ do
+    fails $ cabal "v2-update" []

cabal-testsuite/PackageTests/IndexCabalFileParseError/repo/my-lib-1.0/my-lib.cabal

@@ -0,0 +1,5 @@
+cabal-version:  3.0
+name:           my-lib
+version:        1.0
+license:        puppy license :)
+puppy:          teehee!

cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out

@@ -1,4 +1,5 @@
 # cabal v2-run
+Warning: The package description file ./script.cabal has warnings: script.cabal:0:0: A package using 'cabal-version: >=1.10' must use section syntax. See the Cabal user guide for details.
 Configuration is affected by the following files:
 - cabal.project
 Resolving dependencies...