Reword index-state mismatch warning

Author: jasagredo

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

@@ -79,7 +79,8 @@ import Distribution.Types.PackageName (PackageName)
 import Distribution.Version
          ( Version, VersionRange, mkVersion, intersectVersionRanges )
 import Distribution.Simple.Utils
-         ( die', warn, info, createDirectoryIfMissingVerbose, fromUTF8LBS )
+         ( die', dieNoVerbosity, warn, info
+         , createDirectoryIfMissingVerbose, fromUTF8LBS )
 import Distribution.Client.Setup
          ( RepoContext(..) )
 
@@ -106,7 +107,7 @@ import Distribution.Client.Utils ( byteStringToFilePath
                                  , tryFindAddSourcePackageDesc )
 import Distribution.Utils.Structured (Structured (..), nominalStructure, structuredEncodeFile, structuredDecodeFileOrFail)
 import Distribution.Compat.Time (getFileAge, getModTime)
-import System.Directory (doesFileExist, doesDirectoryExist)
+import System.Directory (doesFileExist, doesDirectoryExist, getModificationTime)
 import System.FilePath
          ( (</>), (<.>), takeFileName, takeExtension, replaceExtension, splitDirectories, normalise, takeDirectory )
 import qualified System.FilePath.Posix as FilePath.Posix
@@ -275,17 +276,12 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do
             return ()
         IndexStateTime ts0 -> do
             when (isiMaxTime isi /= ts0) $
-                if ts0 > isiMaxTime isi
-                    then warn verbosity $
-                                   "Requested index-state " ++ prettyShow ts0
-                                ++ " is newer than '" ++ unRepoName rname ++ "'!"
-                                ++ " Falling back to older state ("
-                                ++ prettyShow (isiMaxTime isi) ++ ")."
-                    else info verbosity $
-                                   "Requested index-state " ++ prettyShow ts0
-                                ++ " does not exist in '"++ unRepoName rname ++"'!"
-                                ++ " Falling back to older state ("
-                                ++ prettyShow (isiMaxTime isi) ++ ")."
+                info verbosity $
+                     "There is no index-state for '"
+                  ++ unRepoName rname ++ "' exactly at the requested timestamp ("
+                  ++ prettyShow ts0 ++ "). Falling back to the previous index-state that exists: "
+                  ++ prettyShow (isiMaxTime isi)
+
             info verbosity ("index-state("++ unRepoName rname ++") = " ++
                               prettyShow (isiMaxTime isi) ++ " (HEAD = " ++
                               prettyShow (isiHeadTime isi) ++ ")")
@@ -364,7 +360,11 @@ readRepoIndex :: Verbosity -> RepoContext -> Repo -> RepoIndexState
               -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo)
 readRepoIndex verbosity repoCtxt repo idxState =
   handleNotFound $ do
-    when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo
+    when (isRepoRemote repo) $ do
+      dt <- getIndexFileAge repo
+      ts <- getIndexTimestamp repo
+      warnIfIndexIsOld dt
+      dieIfRequestedIdxIsNewer ts
     -- note that if this step fails due to a bad repo cache, 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)
@@ -406,6 +406,16 @@ readRepoIndex verbosity repoCtxt repo idxState =
         RepoSecure{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt
         RepoLocalNoIndex {} -> return ()
 
+    dieIfRequestedIdxIsNewer ts = do
+      case idxState of
+        IndexStateHead -> return ()
+        IndexStateTime ts0
+          | ts < ts0 -> die' verbosity $
+                 "Latest known index-state for '" ++ unRepoName (repoName repo) ++ "' ("
+              ++ prettyShow ts ++ ") is older than the requested index-state ("
+              ++ prettyShow ts0 ++ ").\nRun 'cabal update' or set the index-state to a value at or before " ++ prettyShow ts ++ "."
+          | otherwise -> return ()
+
     errMissingPackageList repoRemote =
          "The package list for '" ++ unRepoName (remoteRepoName repoRemote)
       ++ "' does not exist. Run 'cabal update' to download it."
@@ -418,6 +428,14 @@ readRepoIndex verbosity repoCtxt repo idxState =
 getIndexFileAge :: Repo -> IO Double
 getIndexFileAge repo = getFileAge $ indexBaseName repo <.> "tar"
 
+  -- | Get the timestamp of a file.
+getIndexTimestamp :: Repo -> IO Timestamp
+getIndexTimestamp repo = do
+  mb_ts <- utcTimeToTimestamp <$> getModificationTime (indexBaseName repo <.> "tar")
+  case mb_ts of
+    Nothing -> dieNoVerbosity "Can't convert modification time to UTC timestamp"
+    Just ts -> pure ts
+
 -- | A set of files (or directories) that can be monitored to detect when
 -- there might have been a change in the source packages.
 --