Refactor getPackageSourceHashes in cabal-install

Try to leverage the fact that repoTarballPkgsWithMetadata only contains
secure Repos by construction. This allows us to avoid relying on partial
functions or maybes. Add a new data type that contains only the fields
that the RepoSecure constructor has in order to localize changes. Add
convenience functions that convert between Repo and SecureRepo.

Author: sgillespie

cabal-install/src/Distribution/Client/FetchUtils.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE NamedFieldPuns #-}
 -----------------------------------------------------------------------------
 -----------------------------------------------------------------------------
 {-# LANGUAGE RecordWildCards #-}
@@ -156,29 +157,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 =

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,12 +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` (fmap remoteRepoName . maybeRepoRemote . fst))
-                      . sortBy (compare `on` (fmap remoteRepoName . maybeRepoRemote . fst))
+                      . NE.groupBy ((==) `on` (remoteRepoName . secureRemote . fst))
+                      . sortBy (compare `on` (remoteRepoName . secureRemote . fst))
                       $ repoTarballPkgsWithMetadata
                 ]
 

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