Clear index cache if it is old #3033

src/Path/Extra.hs

@@ -14,17 +14,20 @@ module Path.Extra
  ,pathToByteString
  ,pathToLazyByteString
  ,pathToText
+ ,tryGetModificationTime
  ) where
 
-import qualified Data.ByteString.Lazy.Char8 as BSL
-import qualified Data.ByteString.Char8 as BS
-import qualified Data.Text as T
-import qualified Data.Text.Encoding as T
-import Stack.Prelude
 import Data.Bool (bool)
+import Data.Time (UTCTime)
 import Path
 import Path.IO
 import Path.Internal (Path(..))
+import Stack.Prelude
+import System.IO.Error (isDoesNotExistError)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Lazy.Char8 as BSL
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
 import qualified System.FilePath as FP
 
 -- | Convert to FilePath but don't add a trailing slash.
@@ -116,3 +119,6 @@ pathToByteString = T.encodeUtf8 . pathToText
 
 pathToText :: Path b t -> T.Text
 pathToText = T.pack . toFilePath
+
+tryGetModificationTime :: MonadIO m => Path Abs File -> m (Either () UTCTime)
+tryGetModificationTime = liftIO . tryJust (guard . isDoesNotExistError) . getModificationTime

src/Stack/Build/Haddock.hs

@@ -39,7 +39,6 @@ import Stack.Types.PackageIdentifier
 import Stack.Types.PackageName
 import Stack.Types.Runner
 import qualified System.FilePath as FP
-import System.IO.Error (isDoesNotExistError)
 import System.Process.Read
 import Web.Browser (openBrowser)
 
@@ -261,8 +260,6 @@ generateHaddockIndex descr envOverride wc bco dumpPackages docRelFP destDir = do
  , srcInterfaceModTime
  , srcInterfaceAbsFile
  , destInterfaceAbsFile )
- tryGetModificationTime :: Path Abs File -> IO (Either () UTCTime)
- tryGetModificationTime = tryJust (guard . isDoesNotExistError) . getModificationTime
  copyPkgDocs :: (a, UTCTime, Path Abs File, Path Abs File) -> IO ()
  copyPkgDocs (_,srcInterfaceModTime,srcInterfaceAbsFile,destInterfaceAbsFile) = do
  -- Copy dependencies' haddocks to documentation directory. This way, relative @../$pkg-$ver@

src/Stack/PackageIndex.hs

@@ -50,6 +50,7 @@ import Network.HTTP.Client.TLS (getGlobalManager)
 import Network.HTTP.Download
 import Network.URI (parseURI)
 import Path (toFilePath, parseAbsFile)
+import Path.Extra (tryGetModificationTime)
 import Path.IO
 import Stack.Types.Config
 import Stack.Types.PackageIdentifier
@@ -337,7 +338,23 @@ updateIndexHackageSecurity indexName' url (HackageSecurity keyIds threshold) = d
  deleteCache indexName'
  liftIO $ D.renameFile (toFilePath tar ++ "-tmp") (toFilePath tar)
  $logInfo "Updated package list downloaded"
- HS.NoUpdates -> $logInfo "No updates to your package list were found"
+ HS.NoUpdates -> do
+ -- If the index is newer than the cache, delete it so that
+ -- the next 'getPackageCaches' call recomputes it. This
+ -- could happen if a prior run of stack updated the index,
+ -- but exited before deleting the cache.
+ --
+ -- See https:/commercialhaskell/stack/issues/3033
+ mindexModTime <- tryGetModificationTime =<< configPackageIndex indexName'
+ mcacheModTime <- tryGetModificationTime =<< configPackageIndexCache indexName'
+ case (mindexModTime, mcacheModTime) of
+ (Right indexModTime, Right cacheModTime) | cacheModTime < indexModTime -> do
+ deleteCache indexName'
+ $logInfo "No updates to your pakcage list were found, but clearing the index cache as it is older than the index."
+ (Left _, _) -> do
+ deleteCache indexName'
+ $logError "Error: No updates to your package list were found, but downloaded index is missing."
+ _ -> $logInfo "No updates to your package list were found"
 
 -- | Delete the package index cache
 deleteCache :: HasConfig env => IndexName -> RIO env ()