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

This error message was very confusing -- it doesn't tell you what
`.cabal` file it's looking for or why it cannot read the `.cabal` file.
(Did it fail to parse the `.tar` archive itself? Did parsing the
`.cabal` file fail? If so, why?)

This patch improves the error message to include the name of the
`.cabal` file being searched for. Additionally, parse errors and
warnings are printed, as are format failures in the tarball itself.

I ran into this error while I was writing tests for Cabal and it
confused the hell out of me; this is an expanded version of the changes
I made to help debug that failure.

Author: 9999years

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,42 @@ 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
+      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 <-
+                  try $ readSourcePackageCabalFile verbosity expectFilename bytes
+                case maybePackageDescription of
+                  Left exception -> do
+                    warnError 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

@@ -38,6 +38,8 @@ module Distribution.Client.ProjectConfig
   , writeProjectConfigFile
   , commandLineFlagsToProjectConfig
   , onlyTopLevelProvenance
+  , readSourcePackageCabalFile
+  , CabalFileParseError (..)
 
     -- * Packages within projects
   , ProjectPackageLocation (..)
@@ -174,7 +176,6 @@ import Distribution.Simple.Setup
 import Distribution.Simple.Utils
   ( createDirectoryIfMissingVerbose
   , dieWithException
-  , info
   , maybeExit
   , notice
   , rawSystemIOWithEnv
@@ -1615,7 +1616,7 @@ readSourcePackageCabalFile verbosity pkgfilename content =
   case runParseResult (parseGenericPackageDescription content) of
     (warnings, Right pkg) -> do
       unless (null warnings) $
-        info verbosity (formatWarnings warnings)
+        warn verbosity (formatWarnings warnings)
       return pkg
     (warnings, Left (mspecVersion, errors)) ->
       throwIO $ CabalFileParseError pkgfilename content errors mspecVersion warnings

cabal-testsuite/PackageTests/IndexCabalFileParseError/cabal.out

@@ -0,0 +1,19 @@
+# cabal v2-update
+Downloading the latest package list from test-local-repo
+Error: 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/src/Test/Cabal/Prelude.hs

@@ -564,11 +564,9 @@ src `archiveTo` dst = do
 
 infixr 4 `archiveTo`
 
--- | Given a directory (relative to the 'testCurrentDir') containing
--- a series of directories representing packages, generate an
--- external repository corresponding to all of these packages
-withRepo :: FilePath -> TestM a -> TestM a
-withRepo repo_dir m = do
+-- | Like 'withRepo', but doesn't run @cabal update@.
+withRepoNoUpdate :: FilePath -> TestM a -> TestM a
+withRepoNoUpdate repo_dir m = do
     env <- getTestEnv
 
     -- 1. Initialize repo directory
@@ -606,11 +604,7 @@ withRepo repo_dir m = do
     liftIO $ print $ testUserCabalConfigFile env
     liftIO $ print =<< readFile (testUserCabalConfigFile env)
 
-    -- 4. Update our local index
-    -- Note: this doesn't do anything for file+noindex repositories.
-    cabal "v2-update" ["-z"]
-
-    -- 5. Profit
+    -- 4. Profit
     withReaderT (\env' -> env' { testHaveRepo = True }) m
     -- TODO: Arguably should undo everything when we're done...
   where
@@ -620,6 +614,17 @@ withRepo repo_dir m = do
                                             _ -> x)
                                         else id) (testRepoDir env)
 
+-- | Given a directory (relative to the 'testCurrentDir') containing
+-- a series of directories representing packages, generate an
+-- external repository corresponding to all of these packages
+withRepo :: FilePath -> TestM a -> TestM a
+withRepo repo_dir m = do
+    withRepoNoUpdate repo_dir $ do
+        -- Update our local index
+        -- Note: this doesn't do anything for file+noindex repositories.
+        cabal "v2-update" ["-z"]
+        m
+
 -- | Given a directory (relative to the 'testCurrentDir') containing
 -- a series of directories representing packages, generate an
 -- remote repository corresponding to all of these packages
@@ -798,17 +803,31 @@ recordMode mode = withReaderT (\env -> env {
 assertOutputContains :: MonadIO m => WithCallStack (String -> Result -> m ())
 assertOutputContains needle result =
     withFrozenCallStack $
-    unless (needle `isInfixOf` (concatOutput output)) $
+    unless (needle `isInfixOf` concatOutput output) $
     assertFailure $ " expected: " ++ needle
   where output = resultOutput result
 
 assertOutputDoesNotContain :: MonadIO m => WithCallStack (String -> Result -> m ())
 assertOutputDoesNotContain needle result =
     withFrozenCallStack $
-    when (needle `isInfixOf` (concatOutput output)) $
+    when (needle `isInfixOf` concatOutput output) $
     assertFailure $ "unexpected: " ++ needle
   where output = resultOutput result
 
+assertOutputMatches :: MonadIO m => WithCallStack (String -> Result -> m ())
+assertOutputMatches regex result =
+    withFrozenCallStack $
+    unless (concatOutput output =~ regex) $
+    assertFailure $ "expected regex match: " ++ regex
+  where output = resultOutput result
+
+assertOutputDoesNotMatch :: MonadIO m => WithCallStack (String -> Result -> m ())
+assertOutputDoesNotMatch regex result =
+    withFrozenCallStack $
+    when (concatOutput output =~ regex) $
+    assertFailure $ "unexpected regex match: " ++ regex
+  where output = resultOutput result
+
 assertFindInFile :: MonadIO m => WithCallStack (String -> FilePath -> m ())
 assertFindInFile needle path =
     withFrozenCallStack $