From b32aea32b7d40193b754a64d62126a3bb6a2935b Mon Sep 17 00:00:00 2001
From: Gershom Bazerman <gershom@arista.com>
Date: Tue, 24 Jan 2023 13:59:06 -0500
Subject: [PATCH] elim warning spam from 8500
(cherry picked from commit ffa912714fda52e97d117b48d016a6fce0d0e95c)
---
.../src/Distribution/Client/FetchUtils.hs | 38 ++++++++++---------
.../Distribution/Client/ProjectPlanning.hs | 6 +--
2 files changed, 24 insertions(+), 20 deletions(-)
diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs
index 963a94c1ae..f14ef418bd 100644
--- a/cabal-install/src/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/src/Distribution/Client/FetchUtils.hs
@@ -131,25 +131,29 @@ verifyFetchedTarball verbosity repoCtxt repo pkgid =
case res of
Left e -> warn verbosity ("Error verifying fetched tarball " ++ file ++ ", will redownload: " ++ show (e :: SomeException)) >> pure False
Right b -> pure b
- in handleError $ case repo of
- -- a secure repo has hashes we can compare against to confirm this is the correct file.
- RepoSecure{} ->
- repoContextWithSecureRepo repoCtxt repo $ \repoSecure ->
- Sec.withIndex repoSecure $ \callbacks ->
- let warnAndFail s = warn verbosity ("Fetched tarball " ++ file ++ " does not match server, will redownload: " ++ s) >> return False
- -- the do block in parens is due to dealing with the checked exceptions mechanism.
- in (do fileInfo <- Sec.indexLookupFileInfo callbacks pkgid
- sz <- Sec.FileLength . fromInteger <$> getFileSize file
- if sz /= Sec.fileInfoLength (Sec.trusted fileInfo)
- then warnAndFail "file length mismatch"
- else do
- res <- Sec.compareTrustedFileInfo (Sec.trusted fileInfo) <$> Sec.computeFileInfo (Sec.Path file :: Sec.Path Sec.Absolute)
- if res
- then pure True
- else warnAndFail "file hash mismatch")
+ in handleError $ do
+ exists <- doesFileExist file
+ if not exists
+ then return False
+ else case repo of
+ -- a secure repo has hashes we can compare against to confirm this is the correct file.
+ RepoSecure{} ->
+ repoContextWithSecureRepo repoCtxt repo $ \repoSecure ->
+ Sec.withIndex repoSecure $ \callbacks ->
+ let warnAndFail s = warn verbosity ("Fetched tarball " ++ file ++ " does not match server, will redownload: " ++ s) >> return False
+ -- the do block in parens is due to dealing with the checked exceptions mechanism.
+ in (do fileInfo <- Sec.indexLookupFileInfo callbacks pkgid
+ sz <- Sec.FileLength . fromInteger <$> getFileSize file
+ if sz /= Sec.fileInfoLength (Sec.trusted fileInfo)
+ then warnAndFail "file length mismatch"
+ else do
+ res <- Sec.compareTrustedFileInfo (Sec.trusted fileInfo) <$> Sec.computeFileInfo (Sec.Path file :: Sec.Path Sec.Absolute)
+ if res
+ then pure True
+ else warnAndFail "file hash mismatch")
`Sec.catchChecked` (\(e :: Sec.InvalidPackageException) -> warnAndFail (show e))
`Sec.catchChecked` (\(e :: Sec.VerificationError) -> warnAndFail (show e))
- _ -> pure True
+ _ -> pure True
-- | Fetch a package if we don't have it already.
--
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
index 978af213b1..4ec141037b 100644
--- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs
+++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -935,7 +935,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
_ -> Right (pkgid, repo)
| (pkgid, RepoTarballPackage repo _ _) <- allPkgLocations ]
- (repoTarballPkgsWithMetadata, repoTarballPkgsToRedownload) <- fmap partitionEithers $
+ (repoTarballPkgsWithMetadata, repoTarballPkgsToDownloadWithMeta) <- fmap partitionEithers $
liftIO $ withRepoCtx $ \repoctx -> forM repoTarballPkgsWithMetadataUnvalidated $
\x@(pkg, repo) -> verifyFetchedTarball verbosity repoctx repo pkg >>= \b -> case b of
True -> return $ Left x
@@ -944,7 +944,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
-- For tarballs from repos that do not have hashes available we now have
-- to check if the packages were downloaded already.
--
- (repoTarballPkgsToDownload',
+ (repoTarballPkgsToDownloadWithNoMeta,
repoTarballPkgsDownloaded)
<- fmap partitionEithers $
liftIO $ sequence
@@ -954,7 +954,7 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do
Just tarball -> return (Right (pkgid, tarball))
| (pkgid, repo) <- repoTarballPkgsWithoutMetadata ]
- let repoTarballPkgsToDownload = repoTarballPkgsToRedownload ++ repoTarballPkgsToDownload'
+ let repoTarballPkgsToDownload = repoTarballPkgsToDownloadWithMeta ++ repoTarballPkgsToDownloadWithNoMeta
(hashesFromRepoMetadata,
repoTarballPkgsNewlyDownloaded) <-
-- Avoid having to initialise the repository (ie 'withRepoCtx') if we
--
GitLab