diff --git a/.gitignore b/.gitignore index e9ec3b6322f..d7b51e1cfbb 100644 --- a/.gitignore +++ b/.gitignore @@ -83,3 +83,6 @@ bench.html # Emacs .projectile + +# I'm unsure how to ignore these generated golden files +cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index 8f66a33a363..c0f4e05a137 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -98,7 +98,7 @@ import Distribution.Simple.Command import System.FilePath (dropExtension, (<.>)) import Distribution.Client.Errors -import Distribution.Client.IndexUtils.Timestamp (nullTimestamp) +import Distribution.Client.IndexUtils.Timestamp (Timestamp (NoTimestamp)) import qualified Hackage.Security.Client as Sec updateCommand :: CommandUI (NixStyleFlags ()) @@ -257,18 +257,19 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do updateRepoIndexCache verbosity (RepoIndex repoCtxt repo) RepoSecure{} -> repoContextWithSecureRepo repoCtxt repo $ \repoSecure -> do let index = RepoIndex repoCtxt repo - -- NB: This may be a nullTimestamp if we've never updated before - current_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + -- NB: This may be a NoTimestamp if we've never updated before + current_ts <- currentIndexTimestamp (lessVerbose verbosity) index -- NB: always update the timestamp, even if we didn't actually -- download anything writeIndexTimestamp index indexState - ce <- - if repoContextIgnoreExpiry repoCtxt - then Just `fmap` getCurrentTime - else return Nothing - updated <- Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce - -- this resolves indexState (which could be HEAD) into a timestamp - new_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo + + updated <- do + ce <- + if repoContextIgnoreExpiry repoCtxt + then Just <$> getCurrentTime + else return Nothing + Sec.uncheckClientErrors $ Sec.checkForUpdates repoSecure ce + let rname = remoteRepoName (repoRemote repo) -- Update cabal's internal index as well so that it's not out of sync @@ -277,7 +278,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do Sec.NoUpdates -> do now <- getCurrentTime setModificationTime (indexBaseName repo <.> "tar") now - `catchIO` (\e -> warn verbosity $ "Could not set modification time of index tarball -- " ++ displayException e) + `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 @@ -285,6 +287,11 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do noticeNoWrap verbosity $ "Package list of " ++ prettyShow rname ++ " has been updated." + -- This resolves indexState (which could be HEAD) into a timestamp + -- This could be null but should not be, since the above guarantees + -- we have an updated index. + new_ts <- currentIndexTimestamp (lessVerbose verbosity) index + noticeNoWrap verbosity $ "The index-state is set to " ++ prettyShow (IndexStateTime new_ts) ++ "." @@ -294,7 +301,7 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do -- In case current_ts is a valid timestamp different from new_ts, let -- the user know how to go back to current_ts - when (current_ts /= nullTimestamp && new_ts /= current_ts) $ + when (current_ts /= NoTimestamp && new_ts /= current_ts) $ noticeNoWrap verbosity $ "To revert to previous state run:\n" ++ " cabal v2-update '" diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index 5db31ba5d3b..ada3eca5268 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -25,6 +25,9 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BS8 import Data.List (groupBy) +import Distribution.Client.IndexUtils.Timestamp +import Distribution.Client.Types.Repo +import Distribution.Client.Types.RepoName (RepoName (..)) import Distribution.Compat.Prelude import Distribution.Deprecated.ParseUtils (PWarning, showPWarning) import Distribution.Package @@ -179,6 +182,8 @@ data CabalInstallException | FreezeException String | PkgSpecifierException [String] | CorruptedIndexCache String + | UnusableIndexState RemoteRepo Timestamp Timestamp + | MissingPackageList RemoteRepo deriving (Show, Typeable) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -327,6 +332,8 @@ exceptionCodeCabalInstall e = case e of FreezeException{} -> 7156 PkgSpecifierException{} -> 7157 CorruptedIndexCache{} -> 7158 + UnusableIndexState{} -> 7159 + MissingPackageList{} -> 7160 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -828,6 +835,20 @@ exceptionMessageCabalInstall e = case e of FreezeException errs -> errs PkgSpecifierException errorStr -> unlines errorStr CorruptedIndexCache str -> str + UnusableIndexState repoRemote maxFound requested -> + "Latest known index-state for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' (" + ++ prettyShow maxFound + ++ ") is older than the requested index-state (" + ++ prettyShow requested + ++ ").\nRun 'cabal update' or set the index-state to a value at or before " + ++ prettyShow maxFound + ++ "." + MissingPackageList repoRemote -> + "The package list for '" + ++ unRepoName (remoteRepoName repoRemote) + ++ "' does not exist. Run 'cabal update' to download it." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/IndexUtils.hs b/cabal-install/src/Distribution/Client/IndexUtils.hs index e2ea4486426..2dc7d37e29c 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils.hs @@ -212,7 +212,7 @@ data IndexStateInfo = IndexStateInfo } emptyStateInfo :: IndexStateInfo -emptyStateInfo = IndexStateInfo nullTimestamp nullTimestamp +emptyStateInfo = IndexStateInfo NoTimestamp NoTimestamp -- | Filters a 'Cache' according to an 'IndexState' -- specification. Also returns 'IndexStateInfo' describing the @@ -318,40 +318,31 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do IndexStateHead -> do info verbosity ("index-state(" ++ unRepoName rname ++ ") = " ++ prettyShow (isiHeadTime isi)) return () - IndexStateTime ts0 -> do + IndexStateTime ts0 -> + -- isiMaxTime is the latest timestamp in the filtered view returned by + -- `readRepoIndex` above. It is always true that isiMaxTime is less or + -- equal to a requested IndexStateTime. When `isiMaxTime isi /= ts0` (or + -- equivalently `isiMaxTime isi < ts0`) it means that ts0 falls between + -- two timestamps in the index. when (isiMaxTime isi /= ts0) $ - if ts0 > isiMaxTime isi - then - warn verbosity $ - "Requested index-state " - ++ prettyShow ts0 - ++ " is newer than '" + let commonMsg = + "There is no index-state for '" ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - else - info verbosity $ - "Requested index-state " + ++ "' exactly at the requested timestamp (" ++ prettyShow ts0 - ++ " does not exist in '" - ++ unRepoName rname - ++ "'!" - ++ " Falling back to older state (" - ++ prettyShow (isiMaxTime isi) - ++ ")." - info - verbosity - ( "index-state(" - ++ unRepoName rname - ++ ") = " - ++ prettyShow (isiMaxTime isi) - ++ " (HEAD = " - ++ prettyShow (isiHeadTime isi) - ++ ")" - ) - + ++ "). " + in if isNothing $ timestampToUTCTime (isiMaxTime isi) + then + warn verbosity $ + commonMsg + ++ "Also, there are no index-states before the one requested, so the repository '" + ++ unRepoName rname + ++ "' will be empty." + else + info verbosity $ + commonMsg + ++ "Falling back to the previous index-state that exists: " + ++ prettyShow (isiMaxTime isi) pure RepoData { rdRepoName = rname @@ -381,7 +372,7 @@ getSourcePackagesAtIndexState verbosity repoCtxt mb_idxState mb_activeRepos = do [ (n, IndexStateTime ts) | (RepoData n ts _idx _prefs, _strategy) <- pkgss' , -- e.g. file+noindex have nullTimestamp as their timestamp - ts /= nullTimestamp + ts /= NoTimestamp ] let addIndex @@ -439,15 +430,16 @@ readRepoIndex -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo) readRepoIndex verbosity repoCtxt repo idxState = handleNotFound $ do - when (isRepoRemote repo) $ warnIfIndexIsOld =<< getIndexFileAge repo - -- 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) - readPackageIndexCacheFile - verbosity - mkAvailablePackage - (RepoIndex repoCtxt repo) - idxState + ret@(_, _, isi) <- + readPackageIndexCacheFile + verbosity + mkAvailablePackage + (RepoIndex repoCtxt repo) + idxState + when (isRepoRemote repo) $ do + warnIfIndexIsOld =<< getIndexFileAge repo + dieIfRequestedIdxIsNewer isi + pure ret where mkAvailablePackage pkgEntry = SourcePackage @@ -468,8 +460,8 @@ readRepoIndex verbosity repoCtxt repo idxState = if isDoesNotExistError e then do case repo of - RepoRemote{..} -> warn verbosity $ errMissingPackageList repoRemote - RepoSecure{..} -> warn verbosity $ errMissingPackageList repoRemote + RepoRemote{..} -> dieWithException verbosity $ MissingPackageList repoRemote + RepoSecure{..} -> dieWithException verbosity $ MissingPackageList repoRemote RepoLocalNoIndex local _ -> warn verbosity $ "Error during construction of local+noindex " @@ -479,18 +471,25 @@ readRepoIndex verbosity repoCtxt repo idxState = return (mempty, mempty, emptyStateInfo) else ioError e + isOldThreshold :: Double isOldThreshold = 15 -- days warnIfIndexIsOld dt = do when (dt >= isOldThreshold) $ case repo of - RepoRemote{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt - RepoSecure{..} -> warn verbosity $ errOutdatedPackageList repoRemote dt + RepoRemote{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt + RepoSecure{..} -> warn verbosity $ warnOutdatedPackageList repoRemote dt RepoLocalNoIndex{} -> return () - errMissingPackageList repoRemote = - "The package list for '" - ++ unRepoName (remoteRepoName repoRemote) - ++ "' does not exist. Run 'cabal update' to download it." - errOutdatedPackageList repoRemote dt = + dieIfRequestedIdxIsNewer isi = + let latestTime = isiHeadTime isi + in case idxState of + IndexStateTime t -> when (t > latestTime) $ case repo of + RepoSecure{..} -> + dieWithException verbosity $ UnusableIndexState repoRemote latestTime t + RepoRemote{} -> pure () + RepoLocalNoIndex{} -> return () + IndexStateHead -> pure () + + warnOutdatedPackageList repoRemote dt = "The package list for '" ++ unRepoName (remoteRepoName repoRemote) ++ "' is " @@ -852,9 +851,8 @@ withIndexEntries _ (RepoIndex repoCtxt repo@RepoSecure{}) callback _ = where blockNo = Sec.directoryEntryBlockNo dirEntry timestamp = - fromMaybe (error "withIndexEntries: invalid timestamp") $ - epochTimeToTimestamp $ - Sec.indexEntryTime sie + epochTimeToTimestamp $ + Sec.indexEntryTime sie withIndexEntries verbosity (RepoIndex _repoCtxt (RepoLocalNoIndex (LocalRepo name localDir _) _cacheDir)) _ callback = do dirContents <- listDirectory localDir let contentSet = Set.fromList dirContents @@ -942,10 +940,14 @@ withIndexEntries verbosity index callback _ = do callback $ map toCache (catMaybes pkgsOrPrefs) where toCache :: PackageOrDep -> IndexCacheEntry - toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo nullTimestamp + toCache (Pkg (NormalPackage pkgid _ _ blockNo)) = CachePackageId pkgid blockNo NoTimestamp toCache (Pkg (BuildTreeRef refType _ _ _ blockNo)) = CacheBuildTreeRef refType blockNo - toCache (Dep d) = CachePreference d 0 nullTimestamp + toCache (Dep d) = CachePreference d 0 NoTimestamp +-- | Read package data from a repository. +-- Throws IOException if any arise while accessing the index +-- (unless the repo is local+no-index) and dies if the cache +-- is corrupted and cannot be regenerated correctly. readPackageIndexCacheFile :: Package pkg => Verbosity @@ -959,12 +961,18 @@ readPackageIndexCacheFile verbosity mkPkg index idxState (pkgs, prefs) <- packageNoIndexFromCache verbosity mkPkg cache0 pure (pkgs, prefs, emptyStateInfo) | otherwise = do - cache0 <- readIndexCache verbosity index + (cache, isi) <- getIndexCache verbosity index idxState indexHnd <- openFile (indexFile index) ReadMode - let (cache, isi) = filterCache idxState cache0 (pkgs, deps) <- packageIndexFromCache verbosity mkPkg indexHnd cache pure (pkgs, deps, isi) +-- | Read 'Cache' and 'IndexStateInfo' from the repository index file. +-- Throws IOException if any arise (e.g. the index or its cache are missing). +-- Dies if the index cache is corrupted and cannot be regenerated correctly. +getIndexCache :: Verbosity -> Index -> RepoIndexState -> IO (Cache, IndexStateInfo) +getIndexCache verbosity index idxState = + filterCache idxState <$> readIndexCache verbosity index + packageIndexFromCache :: Package pkg => Verbosity @@ -1087,7 +1095,7 @@ packageListFromCache verbosity mkPkg hnd Cache{..} = accum mempty [] mempty cach ------------------------------------------------------------------------ -- Index cache data structure -- --- | Read the 'Index' cache from the filesystem +-- | Read a repository cache from the filesystem -- -- If a corrupted index cache is detected this function regenerates -- the index cache and then reattempt to read the index once (and @@ -1110,6 +1118,11 @@ readIndexCache verbosity index = do either (dieWithException verbosity . CorruptedIndexCache) (return . hashConsCache) =<< readIndexCache' index Right res -> return (hashConsCache res) +-- | Read a no-index repository cache from the filesystem +-- +-- If a corrupted index cache is detected this function regenerates +-- the index cache and then reattempts to read the index once (and +-- 'dieWithException's if it fails again). Throws IOException if any arise. readNoIndexCache :: Verbosity -> Index -> IO NoIndexCache readNoIndexCache verbosity index = do cacheOrFail <- readNoIndexCache' index @@ -1130,11 +1143,12 @@ readNoIndexCache verbosity index = do -- we don't hash cons local repository cache, they are hopefully small Right res -> return res --- | Read the 'Index' cache from the filesystem without attempting to --- regenerate on parsing failures. +-- | Read the 'Index' cache from the filesystem. Throws IO exceptions +-- if any arise and returns Left on invalid input. readIndexCache' :: Index -> IO (Either String Cache) readIndexCache' index - | is01Index index = structuredDecodeFileOrFail (cacheFile index) + | is01Index index = + structuredDecodeFileOrFail (cacheFile index) | otherwise = Right . read00IndexCache <$> BSS.readFile (cacheFile index) @@ -1159,15 +1173,27 @@ writeIndexTimestamp index st = writeFile (timestampFile index) (prettyShow st) -- | Read out the "current" index timestamp, i.e., what --- timestamp you would use to revert to this version -currentIndexTimestamp :: Verbosity -> RepoContext -> Repo -> IO Timestamp -currentIndexTimestamp verbosity repoCtxt r = do - mb_is <- readIndexTimestamp verbosity (RepoIndex repoCtxt r) +-- timestamp you would use to revert to this version. +-- +-- Note: this is not the same as 'readIndexTimestamp'! +-- This resolves HEAD to the index's 'isiHeadTime', i.e. +-- the index latest known timestamp. +-- +-- Return NoTimestamp if the index has never been updated. +currentIndexTimestamp :: Verbosity -> Index -> IO Timestamp +currentIndexTimestamp verbosity index = do + mb_is <- readIndexTimestamp verbosity index case mb_is of - Just (IndexStateTime ts) -> return ts - _ -> do - (_, _, isi) <- readRepoIndex verbosity repoCtxt r IndexStateHead - return (isiHeadTime isi) + -- If the index timestamp file specifies an index state time, use that + Just (IndexStateTime ts) -> + return ts + -- Otherwise used the head time as stored in the index cache + _otherwise -> + fmap (isiHeadTime . snd) (getIndexCache verbosity index IndexStateHead) + `catchIO` \e -> + if isDoesNotExistError e + then return NoTimestamp + else ioError e -- | Read the 'IndexState' from the filesystem readIndexTimestamp :: Verbosity -> Index -> IO (Maybe RepoIndexState) @@ -1259,7 +1285,7 @@ instance NFData NoIndexCacheEntry where rnf (NoIndexCachePreference dep) = rnf dep cacheEntryTimestamp :: IndexCacheEntry -> Timestamp -cacheEntryTimestamp (CacheBuildTreeRef _ _) = nullTimestamp +cacheEntryTimestamp (CacheBuildTreeRef _ _) = NoTimestamp cacheEntryTimestamp (CachePreference _ _ ts) = ts cacheEntryTimestamp (CachePackageId _ _ ts) = ts @@ -1311,7 +1337,7 @@ preferredVersionKey = "pref-ver:" read00IndexCache :: BSS.ByteString -> Cache read00IndexCache bs = Cache - { cacheHeadTs = nullTimestamp + { cacheHeadTs = NoTimestamp , cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs } @@ -1329,7 +1355,7 @@ read00IndexCacheEntry = \line -> ( CachePackageId (PackageIdentifier pkgname pkgver) blockno - nullTimestamp + NoTimestamp ) _ -> Nothing [key, typecodestr, blocknostr] | key == BSS.pack buildTreeRefKey -> @@ -1339,7 +1365,7 @@ read00IndexCacheEntry = \line -> _ -> Nothing (key : remainder) | key == BSS.pack preferredVersionKey -> do pref <- simpleParsecBS (BSS.unwords remainder) - return $ CachePreference pref 0 nullTimestamp + return $ CachePreference pref 0 NoTimestamp _ -> Nothing where parseName str diff --git a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs index 3dfe2963437..10034472277 100644 --- a/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/src/Distribution/Client/IndexUtils/Timestamp.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -12,8 +12,7 @@ -- -- Timestamp type used in package indexes module Distribution.Client.IndexUtils.Timestamp - ( Timestamp - , nullTimestamp + ( Timestamp (NoTimestamp) , epochTimeToTimestamp , timestampToUTCTime , utcTimeToTimestamp @@ -33,38 +32,30 @@ import qualified Distribution.Compat.CharParsing as P import qualified Text.PrettyPrint as Disp -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970). -newtype Timestamp = TS Int64 -- Tar.EpochTime - deriving (Eq, Ord, Enum, NFData, Show, Generic) +data Timestamp = NoTimestamp | TS Int64 -- Tar.EpochTime + deriving (Eq, Ord, NFData, Show, Generic) -epochTimeToTimestamp :: Tar.EpochTime -> Maybe Timestamp -epochTimeToTimestamp et - | ts == nullTimestamp = Nothing - | otherwise = Just ts - where - ts = TS et +epochTimeToTimestamp :: Tar.EpochTime -> Timestamp +epochTimeToTimestamp = TS timestampToUTCTime :: Timestamp -> Maybe UTCTime -timestampToUTCTime (TS t) - | t == minBound = Nothing - | otherwise = Just $ posixSecondsToUTCTime (fromIntegral t) +timestampToUTCTime NoTimestamp = Nothing +timestampToUTCTime (TS t) = Just $ posixSecondsToUTCTime (fromIntegral t) -utcTimeToTimestamp :: UTCTime -> Maybe Timestamp -utcTimeToTimestamp utct - | minTime <= t, t <= maxTime = Just (TS (fromIntegral t)) - | otherwise = Nothing - where - maxTime = toInteger (maxBound :: Int64) - minTime = toInteger (succ minBound :: Int64) - t :: Integer - t = round . utcTimeToPOSIXSeconds $ utct +utcTimeToTimestamp :: UTCTime -> Timestamp +utcTimeToTimestamp = + TS + . (fromIntegral :: Integer -> Int64) + . round + . utcTimeToPOSIXSeconds -- | Compute the maximum 'Timestamp' value -- --- Returns 'nullTimestamp' for the empty list. Also note that --- 'nullTimestamp' compares as smaller to all non-'nullTimestamp' +-- Returns 'NoTimestamp' for the empty list. Also note that +-- 'NoTimestamp' compares as smaller to all non-'NoTimestamp' -- values. maximumTimestamp :: [Timestamp] -> Timestamp -maximumTimestamp [] = nullTimestamp +maximumTimestamp [] = NoTimestamp maximumTimestamp xs@(_ : _) = maximum xs -- returns 'Nothing' if not representable as 'Timestamp' @@ -76,17 +67,11 @@ posixSecondsToTimestamp pt maxTs = toInteger (maxBound :: Int64) minTs = toInteger (succ minBound :: Int64) --- | Pretty-prints 'Timestamp' in ISO8601/RFC3339 format --- (e.g. @"2017-12-31T23:59:59Z"@) --- --- Returns empty string for 'nullTimestamp' in order for --- --- > null (display nullTimestamp) == True --- --- to hold. +-- | Pretty-prints non-null 'Timestamp' in ISO8601/RFC3339 format +-- (e.g. @"2017-12-31T23:59:59Z"@). showTimestamp :: Timestamp -> String showTimestamp ts = case timestampToUTCTime ts of - Nothing -> "" + Nothing -> "Unknown or invalid timestamp" -- Note: we don't use 'formatTime' here to avoid incurring a -- dependency on 'old-locale' for older `time` libs Just UTCTime{..} -> showGregorian utctDay ++ ('T' : showTOD utctDayTime) ++ "Z" @@ -141,7 +126,7 @@ instance Parsec Timestamp where let utc = UTCTime{..} - maybe (fail (show utc ++ " is not representable as timestamp")) return $ utcTimeToTimestamp utc + return $ utcTimeToTimestamp utc parseTwoDigits = do d1 <- P.satisfy isDigit @@ -156,8 +141,3 @@ instance Parsec Timestamp where ds <- P.munch1 isDigit when (length ds < 4) $ fail "Year should have at least 4 digits" return (read (sign : ds)) - --- | Special timestamp value to be used when 'timestamp' is --- missing/unknown/invalid -nullTimestamp :: Timestamp -nullTimestamp = TS minBound diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs index bcd6e4134d1..13e06172f80 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs @@ -184,7 +184,7 @@ instance Arbitrary Timestamp where -- >>> utcTimeToPOSIXSeconds $ UTCTime (fromGregorian 100000 01 01) 0 -- >>> 3093527980800s -- - arbitrary = maybe (toEnum 0) id . epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary + arbitrary = epochTimeToTimestamp . (`mod` 3093527980800) . abs <$> arbitrary instance Arbitrary RepoIndexState where arbitrary = diff --git a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs index 3b53e66c219..29c9fe587e0 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/IndexUtils/Timestamp.hs @@ -23,23 +23,19 @@ tests = prop_timestamp1 :: NonNegative Int -> Bool prop_timestamp1 (NonNegative t0) = Just t == simpleParsec ('@' : show t0) where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow/simpleParse roundtrip prop_timestamp2 :: Int -> Bool -prop_timestamp2 t0 - | t /= nullTimestamp = simpleParsec (prettyShow t) == Just t - | otherwise = prettyShow t == "" +prop_timestamp2 t0 = simpleParsec (prettyShow t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp -- test prettyShow against reference impl prop_timestamp3 :: Int -> Bool -prop_timestamp3 t0 - | t /= nullTimestamp = refDisp t == prettyShow t - | otherwise = prettyShow t == "" +prop_timestamp3 t0 = refDisp t == prettyShow t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp refDisp = maybe undefined (formatTime undefined "%FT%TZ") @@ -47,16 +43,13 @@ prop_timestamp3 t0 -- test utcTimeToTimestamp/timestampToUTCTime roundtrip prop_timestamp4 :: Int -> Bool -prop_timestamp4 t0 - | t /= nullTimestamp = (utcTimeToTimestamp =<< timestampToUTCTime t) == Just t - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp4 t0 = + (utcTimeToTimestamp <$> timestampToUTCTime t) == Just t where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp prop_timestamp5 :: Int -> Bool -prop_timestamp5 t0 - | t /= nullTimestamp = timestampToUTCTime t == Just ut - | otherwise = timestampToUTCTime t == Nothing +prop_timestamp5 t0 = timestampToUTCTime t == Just ut where - t = toEnum t0 :: Timestamp + t = epochTimeToTimestamp $ toEnum t0 :: Timestamp ut = posixSecondsToUTCTime (fromIntegral t0) diff --git a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs index 3b4a36553c7..359d29a33de 100644 --- a/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs +++ b/cabal-testsuite/PackageTests/Get/OnlyDescription/cabal.test.hs @@ -9,3 +9,4 @@ main = cabalTest $ withRepo "repo" $ do cabal "get" [ "criterion", "--only-package-description" ] + void (shell "rm" ["criterion-1.1.4.0.cabal"]) diff --git a/cabal-testsuite/PackageTests/Get/T7248/cabal.out b/cabal-testsuite/PackageTests/Get/T7248/cabal.out index 0c6e3ce035c..a172b425d4d 100644 --- a/cabal-testsuite/PackageTests/Get/T7248/cabal.out +++ b/cabal-testsuite/PackageTests/Get/T7248/cabal.out @@ -1,6 +1,4 @@ # cabal get Warning: /cabal.config: Unrecognized stanza on line 3 -Warning: The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. -Error: [Cabal-7100] -There is no package named 'a-b-s-e-n-t'. -You may need to run 'cabal update' to get the latest list of available packages. +Error: [Cabal-7160] +The package list for 'repo.invalid' does not exist. Run 'cabal update' to download it. diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in new file mode 100644 index 00000000000..969b189c7b8 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in @@ -0,0 +1,13 @@ +# cabal build +Error: [Cabal-7159] +Latest known index-state for 'repository.localhost' (REPLACEME) is older than the requested index-state (4000-01-01T00:00:00Z). +Run 'cabal update' or set the index-state to a value at or before REPLACEME. +# cabal build +Warning: There is no index-state for 'repository.localhost' exactly at the requested timestamp (2023-01-01T00:00:00Z). Also, there are no index-states before the one requested, so the repository 'repository.localhost' will be empty. +Resolving dependencies... +Error: [Cabal-7107] +Could not resolve dependencies: +[__0] trying: fake-pkg-1.0 (user goal) +[__1] unknown package: pkg (dependency of fake-pkg) +[__1] fail (backjumping, conflict set: fake-pkg, pkg) +After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: fake-pkg (2), pkg (1) diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project new file mode 100644 index 00000000000..a6de7296b36 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.project @@ -0,0 +1 @@ +packages: fake-pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs new file mode 100644 index 00000000000..ca26a482d16 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs @@ -0,0 +1,19 @@ +import Test.Cabal.Prelude +import Data.List (isPrefixOf) + +main = cabalTest $ withProjectFile "cabal.project" $ withRemoteRepo "repo" $ do + output <- last + . words + . head + . filter ("Index cache updated to index-state " `isPrefixOf`) + . lines + . resultOutput + <$> recordMode DoNotRecord (cabal' "update" []) + -- update golden output with actual timestamp + shell "cp" ["cabal.out.in", "cabal.out"] + shell "sed" ["-i''", "-e", "s/REPLACEME/" <> output <> "/g", "cabal.out"] + -- This shall fail with an error message as specified in `cabal.out` + fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"] + -- This shall fail by not finding the package, what indicates that it + -- accepted an older index-state. + fails $ cabal "build" ["--index-state=2023-01-01T00:00:00Z", "fake-pkg"] diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs new file mode 100644 index 00000000000..e5f1c882aeb --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/Main.hs @@ -0,0 +1,3 @@ +module Main where + +main = print "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal new file mode 100644 index 00000000000..813542d87f3 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/fake-pkg/fake-pkg.cabal @@ -0,0 +1,8 @@ +version: 1.0 +name: fake-pkg +build-type: Simple +cabal-version: >= 1.2 + +executable my-exe + main-is: Main.hs + build-depends: base, pkg diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs new file mode 100644 index 00000000000..9bb6374ab6c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/Foo.hs @@ -0,0 +1,3 @@ +module Foo (someFunc) where + +someFunc = "hello" diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal new file mode 100644 index 00000000000..b046359bf55 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/repo/pkg-1.0/pkg.cabal @@ -0,0 +1,8 @@ +name: pkg +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +library + exposed-modules: Foo + build-depends: base diff --git a/changelog.d/die-on-missing-pkg-list b/changelog.d/die-on-missing-pkg-list new file mode 100644 index 00000000000..78e25843197 --- /dev/null +++ b/changelog.d/die-on-missing-pkg-list @@ -0,0 +1,11 @@ +synopsis: Die if package list is missing +packages: cabal-install +prs: #8944 + +description: { + +If a package list is missing, `cabal` will now die and suggest the user to run +`cabal update` instead of continuing into not being able to find packages coming +from the remote package server. + +} diff --git a/changelog.d/index-state-cabal-update b/changelog.d/index-state-cabal-update new file mode 100644 index 00000000000..f40ae672709 --- /dev/null +++ b/changelog.d/index-state-cabal-update @@ -0,0 +1,14 @@ +synopsis: Reject index-state younger than cached index file +packages: cabal-install +prs: #8944 + +description: { + +Requesting to use an index-state younger than the cached version will now fail, +telling the user to use an index-state older or equal to the cached file, or to +run `cabal update`. + +The warning for a non-existing index-state has been also demoted to appear only +on verbose logging. + +}