Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
21 changes: 12 additions & 9 deletions cabal-install/src/Distribution/Client/FetchUtils.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
16 changes: 9 additions & 7 deletions cabal-install/src/Distribution/Client/ProjectPlanning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
]
Expand Down Expand Up @@ -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 <-
Expand All @@ -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
]

Expand Down
20 changes: 20 additions & 0 deletions cabal-install/src/Distribution/Client/Types/Repo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,9 @@ module Distribution.Client.Types.Repo
, repoName
, isRepoRemote
, maybeRepoRemote
, SecureRepo (..)
, mkSecureRepo
, secureRepoToRepo

-- * Windows
, asPosixPath
Expand Down Expand Up @@ -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
Expand Down
Loading