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

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

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...

cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptBad/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
 Error: [Cabal-7121]

cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/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...

cabal-testsuite/PackageTests/NewConfigure/ConfigFile/cabal.out

@@ -1,4 +1,5 @@
 # cabal v2-configure
+Warning: The package description file ./ConfigFile.cabal has warnings: ConfigFile.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
 Config file not written due to flag(s).

cabal-testsuite/PackageTests/NewFreeze/BuildTools/new_freeze.out

@@ -1,6 +1,7 @@
 # cabal v2-update
 Downloading the latest package list from test-local-repo
 # cabal v2-build
+Warning: The package description file ./my-local-package.cabal has warnings: my-local-package.cabal:3:23: Packages with 'cabal-version: 1.12' or later should specify a specific version of the Cabal spec of the form 'cabal-version: x.y'. Use 'cabal-version: 1.20'.
 Configuration is affected by the following files:
 - cabal.project
 Resolving dependencies...
@@ -16,6 +17,7 @@ Configuration is affected by the following files:
 Resolving dependencies...
 Wrote freeze file: <ROOT>/cabal.project.freeze
 # cabal v2-build
+Warning: The package description file ./my-local-package.cabal has warnings: my-local-package.cabal:3:23: Packages with 'cabal-version: 1.12' or later should specify a specific version of the Cabal spec of the form 'cabal-version: x.y'. Use 'cabal-version: 1.20'.
 Configuration is affected by the following files:
 - cabal.project
 - cabal.project.freeze

cabal-testsuite/PackageTests/Regression/T7234/Fail/cabal.out

@@ -1,4 +1,5 @@
 # cabal v2-build
+Warning: The package description file ./issue7234.cabal has warnings: issue7234.cabal:13:3: The field "other-extensions" is available only since the Cabal specification version 1.10.
 Configuration is affected by the following files:
 - cabal.project
 Resolving dependencies...

cabal-testsuite/PackageTests/Regression/T7234/Success/cabal.out

@@ -1,4 +1,5 @@
 # cabal v2-build
+Warning: The package description file ./issue7234.cabal has warnings: issue7234.cabal:14:3: The field "other-extensions" is available only since the Cabal specification version 1.10.
 Configuration is affected by the following files:
 - cabal.project
 Resolving dependencies...

cabal-testsuite/PackageTests/Regression/T9640/cabal.out

@@ -1,6 +1,7 @@
 # cabal v2-update
 Downloading the latest package list from test-local-repo
 # cabal build
+Warning: The package description file ./depend-on-custom-with-exe.cabal has warnings: depend-on-custom-with-exe.cabal:16:1: Ignoring trailing fields after sections: "ghc-options"
 Configuration is affected by the following files:
 - cabal.project
 Resolving dependencies...

cabal-testsuite/src/Test/Cabal/OutputNormalizer.hs

@@ -21,7 +21,7 @@ normalizeOutput :: NormalizerEnv -> String -> String
 normalizeOutput nenv =
     -- Normalize backslashes to forward slashes to normalize
     -- file paths
-    map (\c -> if c == '\\' then '/' else c)
+    backslashToSlash
     -- Install path frequently has architecture specific elements, so
     -- nub it out
   . resub "Installing (.+) in .+" "Installing \\1 in <PATH>"
@@ -46,6 +46,24 @@ normalizeOutput nenv =
   . resub (posixRegexEscape "tmp/src-" ++ "[0-9]+") "<TMPDIR>"
   . resub (posixRegexEscape (normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
   . resub (posixRegexEscape (normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
+  . (if buildOS == Windows
+        then
+          -- OK. Here's the deal. In `./Prelude.hs`, `withRepoNoUpdate` sets
+          -- `repoUri` to the tmpdir but with backslashes replaced with
+          -- slashes. This is because Windows treats backslashes and forward
+          -- slashes largely the same in paths, and backslashes aren't allowed
+          -- in a URL like `file+noindex://...`.
+          --
+          -- But that breaks the regexes above, which expect the paths to have
+          -- backslashes.
+          --
+          -- Honestly this whole `normalizeOutput` thing is super janky and
+          -- worth rewriting from the ground up. To you, poor soul in the
+          -- future, here is one more hack upon a great pile. Hey, at least all
+          -- the `PackageTests` function as a test suite for this thing...
+            resub (posixRegexEscape (backslashToSlash $ normalizerTmpDir nenv) ++ sameDir) "<ROOT>/"
+          . resub (posixRegexEscape (backslashToSlash $ normalizerCanonicalTmpDir nenv) ++ sameDir) "<ROOT>/"
+        else id)
       -- Munge away C: prefix on filenames (Windows). We convert C:\\ to \\.
   . (if buildOS == Windows then resub "([A-Z]):\\\\" "\\\\" else id)
   . appEndo (F.fold (map (Endo . packageIdRegex) (normalizerKnownPackages nenv)))
@@ -154,6 +172,9 @@ posixSpecialChars = ".^$*+?()[{\\|"
 posixRegexEscape :: String -> String
 posixRegexEscape = concatMap (\c -> if c `elem` posixSpecialChars then ['\\', c] else [c])
 
+backslashToSlash :: String -> String
+backslashToSlash = map (\c -> if c == '\\' then '/' else c)
+
 -- From regex-compat-tdfa by Christopher Kuklewicz and shelarcy, BSD-3-Clause
 -------------------------