diff --git a/cabal-install/src/Distribution/Client/FetchUtils.hs b/cabal-install/src/Distribution/Client/FetchUtils.hs index 62da386573d..c3e5f2a451f 100644 --- a/cabal-install/src/Distribution/Client/FetchUtils.hs +++ b/cabal-install/src/Distribution/Client/FetchUtils.hs @@ -156,29 +156,32 @@ checkRepoTarballFetched repo pkgid = do verifyFetchedTarballs :: Verbosity -> RepoContext - -> Repo + -> SecureRepo -> [PackageId] -> IO ( [ Either - (Repo, PackageId) -- Verified + (SecureRepo, PackageId) -- Verified SecureRepo (Repo, PackageId) -- unverified) ] ) -verifyFetchedTarballs verbosity repoCtxt repo pkgids = +verifyFetchedTarballs verbosity repoCtxt secureRepo pkgids = -- Establish the context once per repo (see #10110), this codepath is important -- to be fast as it can happen when no other building happens. let establishContext k = - case repo of - RepoSecure{} -> - repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> - Sec.withIndex repoSecure $ \callbacks -> k (Just callbacks) - _ -> k Nothing + repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> + Sec.withIndex repoSecure $ \callbacks -> + k (Just callbacks) + + repo = secureRepoToRepo secureRepo in do establishContext $ \mCallbacks -> forM pkgids $ \pkgid -> do let file = packageFile repo pkgid res <- verifyFetchedTarball verbosity file mCallbacks pkgid - return $ if res then Left (repo, pkgid) else Right (repo, pkgid) + return $ + if res + then Left (secureRepo, pkgid) + else Right (repo, pkgid) verifyFetchedTarball :: Verbosity -> FilePath -> Maybe Sec.IndexCallbacks -> PackageId -> IO Bool verifyFetchedTarball verbosity file mCallbacks pkgid = diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 0cd1c5377fd..b89852e9ab0 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1171,14 +1171,14 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do -- Tarballs from repositories, either where the repository provides -- hashes as part of the repo metadata, or where we will have to -- download and hash the tarball. - repoTarballPkgsWithMetadataUnvalidated :: [(Repo, [PackageId])] + repoTarballPkgsWithMetadataUnvalidated :: [(SecureRepo, [PackageId])] repoTarballPkgsWithoutMetadata :: [(Repo, PackageId)] ( repoTarballPkgsWithMetadataUnvalidated , repoTarballPkgsWithoutMetadata ) = partitionEithers [ case repo of - RepoSecure{} -> Left (repo, [pkgid]) + RepoSecure r dir -> Left (SecureRepo r dir, [pkgid]) _ -> Right (repo, pkgid) | (pkgid, RepoTarballPackage repo _ _) <- allPkgLocations ] @@ -1230,8 +1230,8 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do fmap (Map.fromList . concat) $ sequence -- Reading the repo index is expensive so we group the packages by repo - [ repoContextWithSecureRepo repoctx repo $ \secureRepo -> - Sec.withIndex secureRepo $ \repoIndex -> + [ repoContextWithSecureRepo repoctx (secureRepoToRepo secureRepo) $ \repo -> + Sec.withIndex repo $ \repoIndex -> sequence [ do hash <- @@ -1244,10 +1244,12 @@ getPackageSourceHashes verbosity withRepoCtx solverPlan = do return (pkgid, hashFromTUF hash) | pkgid <- pkgids ] - | (repo, pkgids) <- + | (secureRepo, pkgids) <- + -- All Repos here are SecureRepos (and will have a name), so we're + -- sorting Justs map (\grp@((repo, _) :| _) -> (repo, map snd (NE.toList grp))) - . NE.groupBy ((==) `on` (remoteRepoName . repoRemote . fst)) - . sortBy (compare `on` (remoteRepoName . repoRemote . fst)) + . NE.groupBy ((==) `on` (remoteRepoName . secureRemote . fst)) + . sortBy (compare `on` (remoteRepoName . secureRemote . fst)) $ repoTarballPkgsWithMetadata ] diff --git a/cabal-install/src/Distribution/Client/Types/Repo.hs b/cabal-install/src/Distribution/Client/Types/Repo.hs index 4b6b19cbc6c..3eb655e6ee4 100644 --- a/cabal-install/src/Distribution/Client/Types/Repo.hs +++ b/cabal-install/src/Distribution/Client/Types/Repo.hs @@ -19,6 +19,9 @@ module Distribution.Client.Types.Repo , repoName , isRepoRemote , maybeRepoRemote + , SecureRepo (..) + , mkSecureRepo + , secureRepoToRepo -- * Windows , asPosixPath @@ -223,6 +226,23 @@ repoName (RepoLocalNoIndex r _) = localRepoName r repoName (RepoRemote r _) = remoteRepoName r repoName (RepoSecure r _) = remoteRepoName r +-- | Secure repositories +-- +-- This contains the same fields as `Repo`'s constructor `RepoSecure`, but is kept +-- separate to keep API breakages low +data SecureRepo = SecureRepo + { secureRemote :: RemoteRepo + , secureLocalDir :: FilePath + } + deriving (Show, Eq, Ord, Generic) + +mkSecureRepo :: Repo -> Maybe SecureRepo +mkSecureRepo (RepoSecure r dir) = Just (SecureRepo r dir) +mkSecureRepo _ = Nothing + +secureRepoToRepo :: SecureRepo -> Repo +secureRepoToRepo (SecureRepo r dir) = RepoSecure r dir + ------------------------------------------------------------------------------- -- * Windows utils