Use a per-version cache file for the index state

cabal-install will now use a version suffixed cache file for the index
state.

If you are regularly changing between cabal-install versions, this will
be less annoying as you won't have to regenerate the cache each time you
switch project.

There is one tricky part of the implementation. If you update the index
with a newer cabal-install, then the old-style cabal-install caches are
invalidated by replacing them with an empty file.
This is because in cabal-install (until this commit), the freshness of
the cache was now checked by `readIndexCache`.

If you update with an older `cabal-install` then the freshness check
will see the cache for your new cabal-install is older than the index,
and update it.

Fixes #7502

Author: mpickering

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

@@ -23,9 +23,11 @@ import Distribution.Client.HttpUtils
   )
 import Distribution.Client.IndexUtils
   ( Index (..)
+  , IndexFileType(..)
   , currentIndexTimestamp
-  , indexBaseName
+  , indexFilePath
   , updatePackageIndexCacheFile
+  , clearPackageIndexCacheFiles
   , updateRepoIndexCache
   , writeIndexTimestamp
   )
@@ -93,7 +95,7 @@ import Distribution.Simple.Command
   ( CommandUI (..)
   , usageAlternatives
   )
-import System.FilePath (dropExtension, (<.>))
+import System.FilePath (dropExtension)
 
 import Distribution.Client.Errors
 import Distribution.Client.IndexUtils.Timestamp (Timestamp (NoTimestamp))
@@ -245,11 +247,12 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do
           repoLocalDir
       case downloadResult of
         FileAlreadyInCache ->
-          setModificationTime (indexBaseName repo <.> "tar")
+          setModificationTime (indexFilePath repo IndexTar)
             =<< getCurrentTime
         FileDownloaded indexPath -> do
           writeFileAtomic (dropExtension indexPath) . maybeDecompress
             =<< BS.readFile indexPath
+          clearPackageIndexCacheFiles verbosity (RepoIndex repoCtxt repo)
           updateRepoIndexCache verbosity (RepoIndex repoCtxt repo)
     RepoSecure{} -> repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> do
       let index = RepoIndex repoCtxt repo
@@ -273,12 +276,13 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do
       case updated of
         Sec.NoUpdates -> do
           now <- getCurrentTime
-          setModificationTime (indexBaseName repo <.> "tar") now
+          setModificationTime (indexFilePath repo IndexTar) now
             `catchIO` \e ->
               warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e
           noticeNoWrap verbosity $
             "Package list of " ++ prettyShow rname ++ " is up to date."
         Sec.HasUpdates -> do
+          clearPackageIndexCacheFiles verbosity index
           updateRepoIndexCache verbosity index
           noticeNoWrap verbosity $
             "Package list of " ++ prettyShow rname ++ " has been updated."

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

@@ -20,7 +20,8 @@
 module Distribution.Client.IndexUtils
   ( getIndexFileAge
   , getInstalledPackages
-  , indexBaseName
+  , indexFilePath
+  , IndexFileType(..)
   , Configure.getInstalledPackagesMonitorFiles
   , getSourcePackages
   , getSourcePackagesMonitorFiles
@@ -34,6 +35,7 @@ module Distribution.Client.IndexUtils
   , parsePackageIndex
   , updateRepoIndexCache
   , updatePackageIndexCacheFile
+  , clearPackageIndexCacheFiles
   , writeIndexTimestamp
   , currentIndexTimestamp
   , BuildTreeRefType (..)
@@ -61,6 +63,8 @@ import Distribution.Client.Types
 import Distribution.Parsec (simpleParsecBS)
 import Distribution.Verbosity
 
+import Distribution.Client.Version
+
 import Distribution.Client.ProjectConfig
   ( CabalFileParseError
   , readSourcePackageCabalFile'
@@ -137,7 +141,7 @@ import Distribution.Compat.Directory (listDirectory)
 import Distribution.Compat.Time (getFileAge, getModTime)
 import Distribution.Utils.Generic (fstOf3)
 import Distribution.Utils.Structured (Structured (..), nominalStructure, structuredDecodeFileOrFail, structuredEncodeFile)
-import System.Directory (doesDirectoryExist, doesFileExist)
+import System.Directory (doesDirectoryExist, doesFileExist, removeFile)
 import System.FilePath
   ( normalise
   , splitDirectories
@@ -168,22 +172,36 @@ getInstalledPackages verbosity comp packageDbs progdb =
   where
     verbosity' = lessVerbose verbosity
 
--- | Get filename base (i.e. without file extension) for index-related files
+-- | Get filenames for index-related files
 --
 -- /Secure/ cabal repositories use a new extended & incremental
 -- @01-index.tar@. In order to avoid issues resulting from clobbering
 -- new/old-style index data, we save them locally to different names.
 --
--- Example: Use @indexBaseName repo <.> "tar.gz"@ to compute the 'FilePath' of the
+-- Example: Use @indexFilePath repo IndexTarGz@ to compute the 'FilePath' of the
 -- @00-index.tar.gz@/@01-index.tar.gz@ file.
-indexBaseName :: Repo -> FilePath
-indexBaseName repo = repoLocalDir repo </> fn
+
+indexFilePath :: Repo -> IndexFileType -> FilePath
+indexFilePath repo idx_file =
+  case idx_file of
+    IndexTarGz -> repoLocalDir repo </> fn <.> "tar.gz"
+    IndexTar   -> repoLocalDir repo </> fn <.> "tar"
+    IndexCache -> repoLocalDir repo </> (fn <.> "cache-" <> prettyShow cabalInstallVersion)
+    IndexTimestamp -> repoLocalDir repo </> fn <.> "timestamp"
+    OldIndexCache -> repoLocalDir repo </> fn <.> "cache"
   where
     fn = case repo of
       RepoSecure{} -> "01-index"
       RepoRemote{} -> "00-index"
       RepoLocalNoIndex{} -> "noindex"
 
+-- | The types of the files which are associated with a particular index.
+data IndexFileType = IndexTarGz
+                   | IndexTar
+                   | IndexCache     -- ^ The specific cache file, for this version of cabal-install
+                   | IndexTimestamp -- ^ The timestamp file for the index
+                   | OldIndexCache -- ^ The location that old versions (before 3.16) of cabal-install put the index cache
+
 ------------------------------------------------------------------------
 -- Reading the source package index
 --
@@ -495,15 +513,15 @@ readRepoIndex verbosity repoCtxt repo idxState =
 
 -- | Return the age of the index file in days (as a Double).
 getIndexFileAge :: Repo -> IO Double
-getIndexFileAge repo = getFileAge $ indexBaseName repo <.> "tar"
+getIndexFileAge repo = getFileAge $ indexFilePath repo IndexTar
 
 -- | A set of files (or directories) that can be monitored to detect when
 -- there might have been a change in the source packages.
 getSourcePackagesMonitorFiles :: [Repo] -> [FilePath]
 getSourcePackagesMonitorFiles repos =
   concat
-    [ [ indexBaseName repo <.> "cache"
-      , indexBaseName repo <.> "timestamp"
+    [ [ indexFilePath repo IndexCache
+      , indexFilePath repo IndexTimestamp
       ]
     | repo <- repos
     ]
@@ -752,13 +770,13 @@ data Index
     RepoIndex RepoContext Repo
 
 indexFile :: Index -> FilePath
-indexFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "tar"
+indexFile (RepoIndex _ctxt repo) = indexFilePath repo IndexTar
 
 cacheFile :: Index -> FilePath
-cacheFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "cache"
+cacheFile (RepoIndex _ctxt repo) = indexFilePath repo IndexCache
 
 timestampFile :: Index -> FilePath
-timestampFile (RepoIndex _ctxt repo) = indexBaseName repo <.> "timestamp"
+timestampFile (RepoIndex _ctxt repo) = indexFilePath repo IndexTimestamp
 
 -- | Return 'True' if 'Index' uses 01-index format (aka secure repo)
 is01Index :: Index -> Bool
@@ -767,6 +785,32 @@ is01Index (RepoIndex _ repo) = case repo of
   RepoRemote{} -> False
   RepoLocalNoIndex{} -> True
 
+
+-- | Clear the cache files for old cabal-install versions which have a cache
+-- for this index. The cache will be invalid now that we have downloaded a new
+-- .tar.gz for the index.
+--
+-- Note that this invalidation logic only invalidates the old-style caches for
+-- cabal-install < 3.16. For never versions, the check in `readIndexCache` that the
+-- cache is older than the indexFile is sufficient to update the caches when required.
+--
+-- If the old version of cabal-install is used again, then this file will be generated
+-- lazily.
+clearPackageIndexCacheFiles :: Verbosity -> Index -> IO ()
+clearPackageIndexCacheFiles verbosity (RepoIndex _ repo) = do
+  info verbosity ("Deleting caches if they exist for " ++ prettyShow (repoName repo))
+  let old_cache_path = indexFilePath repo OldIndexCache
+  -- Delete old-style non-versioned caches, if the file existed then replace
+  -- it with an empty file. Otherwise old versions of `cabal-install` will complain
+  -- about a missing package list.
+  (removeFile old_cache_path
+    >> writeFile old_cache_path "") `catch` handleExists
+
+  where
+    handleExists e
+      | isDoesNotExistError e = return ()
+      | otherwise = throwIO e
+
 updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
 updatePackageIndexCacheFile verbosity index = do
   info verbosity ("Updating index cache file " ++ cacheFile index ++ " ...")
@@ -1139,12 +1183,24 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach
 
 -- | Read a repository cache from the filesystem
 --
+-- If an out-dated cache is detected, the cache is older than the .tar file corresponding
+-- to the cache, the cache is updated.
+--
 -- If a corrupted index cache is detected this function regenerates
 -- the index cache and then reattempt to read the index once (and
 -- 'dieWithException's if it fails again).
 readIndexCache :: Verbosity -> Index -> IO Cache
 readIndexCache verbosity index = do
+  -- 1. Update the cache, if it's out of date.
+  -- This covers the case where
+  -- - The index .tar.gz is downloaded, but the cache is missing.
+  -- - The index .tar.gz is downloaded, but the cache is too old (ie updated by another cabal-install)
+
+  -- This also fails with a "does not exist" error is the .tar.gz is not downloaded. That's important for
+  -- the control flow of functions which call this.
+  updateRepoIndexCache verbosity index
   cacheOrFail <- readIndexCache' index
+  -- 2. Regenerate the cache if parsing failed.
   case cacheOrFail of
     Left msg -> do
       warn verbosity $