Better recovery from a few index/tar errors (haskell#7972)

* don't crash on a few stray exceptions * try -> catch and display * act on reviewer comments Co-authored-by: Gershom Bazerman <gershom@arista.com>
Kleidukos · Mar 30, 2022 · 53977f4 · 53977f4
1 parent 2d3ac0b
commit 53977f4
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 8 deletions.
diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE LambdaCase      #-}
 {-# LANGUAGE NamedFieldPuns  #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections   #-}
 {-# LANGUAGE ViewPatterns    #-}
 
@@ -13,6 +14,7 @@ module Distribution.Client.CmdUpdate (
   ) where
 
 import Prelude ()
+import Control.Exception
 import Distribution.Client.Compat.Prelude
 
 import Distribution.Client.NixStyleOptions
@@ -42,7 +44,7 @@ import Distribution.Client.Setup
 import Distribution.Simple.Flag
          ( fromFlagOrDefault )
 import Distribution.Simple.Utils
-         ( die', notice, wrapText, writeFileAtomic, noticeNoWrap )
+         ( die', notice, wrapText, writeFileAtomic, noticeNoWrap, warn )
 import Distribution.Verbosity
          ( normal, lessVerbose )
 import Distribution.Client.IndexUtils.Timestamp
@@ -209,7 +211,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do
       case updated of
         Sec.NoUpdates  -> do
           now <- getCurrentTime
-          setModificationTime (indexBaseName repo <.> "tar") now
+          setModificationTime (indexBaseName repo <.> "tar") 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 at index-state " ++ prettyShow (IndexStateTime current_ts)

diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs
@@ -247,7 +247,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
             " as explicitly requested (via command line / project configuration)"
           return idxState
         Nothing -> do
-          mb_idxState' <- readIndexTimestamp (RepoIndex repoCtxt r)
+          mb_idxState' <- readIndexTimestamp verbosity (RepoIndex repoCtxt r)
           case mb_idxState' of
             Nothing -> do
               info verbosity "Using most recent state (could not read timestamp file)"
@@ -365,7 +365,9 @@ readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState
 readRepoIndex verbosity repoCtxt repo idxState =
   handleNotFound $ do
     when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo
-    updateRepoIndexCache verbosity (RepoIndex repoCtxt repo)
+    -- note that if this step fails due to a bad repocache, the the procedure can still succeed by reading from the existing cache, which is updated regardless.
+    updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) `catchIO`
+       (\e -> warn verbosity $ "unable to update the repo index cache -- " ++ displayException e)
     readPackageIndexCacheFile verbosity mkAvailablePackage
                               (RepoIndex repoCtxt repo)
                               idxState
@@ -1054,21 +1056,23 @@ writeIndexTimestamp index st
 -- timestamp you would use to revert to this version
 currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp
 currentIndexTimestamp verbosity repoCtxt r = do
-    mb_is <- readIndexTimestamp (RepoIndex repoCtxt r)
+    mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r)
     case mb_is of
       Just (IndexStateTime ts) -> return ts
       _ -> do
         (_,_,isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead
         return (isiHeadTime isi)
 
 -- | Read the 'IndexState' from the filesystem
-readIndexTimestamp :: Index -> IO (Maybe RepoIndexState)
-readIndexTimestamp index
+readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState)
+readIndexTimestamp verbosity index
   = fmap simpleParsec (readFile (timestampFile index))
         `catchIO` \e ->
             if isDoesNotExistError e
                 then return Nothing
-                else ioError e
+                else do
+                   warn verbosity $ "Warning: could not read current index timestamp: " ++ displayException e
+                   return Nothing
 
 -- | Optimise sharing of equal values inside 'Cache'
 --