diff --git a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out new file mode 100644 index 00000000000..6b2c1630928 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out @@ -0,0 +1,17 @@ +# cabal update +Downloading the latest package list from test-local-repo +Package list of test-local-repo has been updated. +The index-state is set to 2023-12-25T00:00:00Z. +# cabal build +Error: [Cabal-7159] +Latest known index-state for 'test-local-repo' (2023-12-25T00:00:00Z) 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 2023-12-25T00:00:00Z. +# cabal build +Warning: There is no index-state for 'test-local-repo' exactly at the requested timestamp (2023-01-01T00:00:00Z). Also, there are no index-states before the one requested, so the repository 'test-local-repo' 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.out.in b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in deleted file mode 100644 index 969b189c7b8..00000000000 --- a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in +++ /dev/null @@ -1,13 +0,0 @@ -# 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.test.hs b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs index ca26a482d16..5a7fc68696b 100644 --- a/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs @@ -1,19 +1,15 @@ 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"] +main = + cabalTest $ + withProjectFile "cabal.project" $ do + -- This is the head index-state + iso8601ParseM "2023-12-25T00:00:00Z" + >>= setModificationTime "repo/pkg-1.0/pkg.cabal" + withSecureRepo "repo" $ do + cabal "update" [] + -- 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/UpdateIndexState/update-index-state.out b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out index d63c65ec921..646159edd45 100644 --- a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out +++ b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out @@ -1,12 +1,14 @@ # cabal update -Downloading the latest package list from repository.localhost -Package list of repository.localhost is up to date. -The index-state is set to 2016-09-24T17:47:48Z. -To revert to previous state run: - cabal v2-update 'repository.localhost,2022-01-28T02:36:41Z' +Downloading the latest package list from test-local-repo +Package list of test-local-repo has been updated. +The index-state is set to 2023-01-01T00:00:00Z. # cabal update -Downloading the latest package list from repository.localhost -Package list of repository.localhost is up to date. -The index-state is set to 2022-01-28T02:36:41Z. +Downloading the latest package list from test-local-repo +Package list of test-local-repo is up to date. +The index-state is set to 2022-01-01T00:00:00Z. To revert to previous state run: - cabal v2-update 'repository.localhost,2016-09-24T17:47:48Z' + cabal v2-update 'test-local-repo,2023-01-01T00:00:00Z' +# cabal update +Downloading the latest package list from test-local-repo +Package list of test-local-repo is up to date. +The index-state is set to 2022-01-01T00:00:00Z. diff --git a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs index 2be563c6bec..e9c66129bd1 100644 --- a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs +++ b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs @@ -1,12 +1,15 @@ import Test.Cabal.Prelude -main = cabalTest $ withRemoteRepo "repo" $ do - -- The _first_ update call causes a warning about missing mirrors, the warning - -- is platform-dependent and it's not part of the test expectations, so we - -- check the output manually. - res <- recordMode DoNotRecord $ - cabal' "update" ["repository.localhost,2022-01-28T02:36:41Z"] - assertOutputContains "The index-state is set to 2022-01-28T02:36:41Z" res - assertOutputDoesNotContain "revert" res - cabal "update" ["repository.localhost,2016-09-24T17:47:48Z"] - cabal "update" ["repository.localhost,2022-01-28T02:36:41Z"] +main = cabalTest $ do + -- This is the head index-state + iso8601ParseM "2023-01-01T00:00:00Z" + >>= setModificationTime ("repo" "pkg-1.0/pkg.cabal") + + withSecureRepo "repo" $ do + cabal "update" [] + + -- Check that we mention the previous timestamp + res <- cabal' "update" ["test-local-repo,2022-01-01T00:00:00Z"] + assertOutputContains "test-local-repo,2023-01-01T00:00:00Z" res + + cabal "update" ["test-local-repo,2022-01-01T00:00:00Z"] diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 677fcdce098..f3a325e9c83 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -68,7 +68,6 @@ library , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 , exceptions ^>= 0.10.0 , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 || ^>= 1.5.0.0 - , network-wait ^>= 0.1.2.0 || ^>= 0.2.0.0 , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 || ^>= 0.18.1.0 , process ^>= 1.2.1.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 , regex-base ^>= 0.94.0.1 @@ -77,6 +76,8 @@ library , array ^>= 0.4.0.1 || ^>= 0.5.0.0 , temporary ^>= 1.3 , text ^>= 1.2.3.1 || ^>= 2.0.1 || ^>= 2.1 + , time-compat ^>= 1.9.0.0 + , time , transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 || ^>= 0.6.0.2 if !os(windows) diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index a7d426fc437..f7bb158fc81 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -239,7 +239,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do -- Add test suite specific programs let program_db0 = addKnownPrograms - ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram, python3Program] ++ builtinPrograms) + ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram] ++ builtinPrograms) (runnerProgramDb senv) -- Reconfigure according to user flags let cargs = testCommonArgs args diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 2c54deaa2a2..5e892ef0c27 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -15,6 +15,7 @@ module Test.Cabal.Prelude ( module Control.Monad.IO.Class, module Distribution.Version, module Distribution.Simple.Program, + module Data.Time.Format.ISO8601.Compat ) where import Test.Cabal.Script @@ -35,7 +36,8 @@ import Distribution.Simple.Configure ( getPersistBuildConfig ) import Distribution.Version import Distribution.Package -import Distribution.Parsec (eitherParsec) +import Distribution.Parsec (eitherParsec, simpleParsec) +import Distribution.Pretty (prettyShow) import Distribution.Types.UnqualComponentName import Distribution.Types.LocalBuildInfo import Distribution.PackageDescription @@ -58,15 +60,15 @@ import qualified Data.ByteString.Char8 as C import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE -import Data.Maybe (mapMaybe, fromMaybe) +import Data.Maybe (mapMaybe, fromMaybe, fromJust) import System.Exit (ExitCode (..)) import System.FilePath import Control.Concurrent (threadDelay) import qualified Data.Char as Char -import System.Directory -import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay) -import Network.Wait (waitTcpVerbose) import System.Environment +import Data.Time +import Data.Time.Format.ISO8601.Compat (iso8601ParseM) +import System.Directory #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -527,7 +529,6 @@ src `archiveTo` dst = do -- TODO: --format ustar, like createArchive? -- --force-local is necessary for handling colons in Windows paths. tar $ ["-czf", dst] - ++ ["--force-local" | buildOS == Windows] ++ ["-C", src_parent, src_dir] infixr 4 `archiveTo` @@ -589,83 +590,78 @@ withRepo repo_dir m = do repoUri env ="file+noindex://" ++ testRepoDir env -- | Given a directory (relative to the 'testCurrentDir') containing --- a series of directories representing packages, generate an --- remote repository corresponding to all of these packages -withRemoteRepo :: FilePath -> TestM a -> TestM a -withRemoteRepo repoDir m = do - -- https://github.com/haskell/cabal/issues/7065 - -- you don't simply put a windows path into URL... - skipIfWindows +-- a series of directories representing packages, generate a +-- secure repository corresponding to all of these packages +withSecureRepo :: FilePath -> TestM a -> TestM a +withSecureRepo repo_dir m = do + env <- getTestEnv - -- we rely on the presence of python3 for a simple http server - skipUnless "no python3" =<< isAvailableProgram python3Program - -- we rely on hackage-repo-tool to set up the secure repository - skipUnless "no hackage-repo-tool" =<< isAvailableProgram hackageRepoToolProgram + -- 1. Generate keys + hackageRepoTool "create-keys" ["--keys", testKeysDir env] + keyIds <- liftIO $ fmap (map takeBaseName) $ listDirectory (testKeysDir env "root") - env <- getTestEnv + -- 2. Create root and mirrors metadata + hackageRepoTool "create-root" ["--keys", testKeysDir env, "-o", testRepoDir env "root.json"] + hackageRepoTool "create-mirrors" ["--keys", testKeysDir env, "-o", testRepoDir env "mirrors.json"] - let workDir = testRepoDir env + -- 3. Create repo directories + let package_dir = testRepoDir env "package" + index_dir = testRepoDir env "index" + liftIO $ createDirectoryIfMissing True package_dir + liftIO $ createDirectoryIfMissing True index_dir - -- 1. Initialize repo and repo_keys directory - let keysDir = workDir "keys" - let packageDir = workDir "package" + -- 4. Create tarballs + pkgs <- liftIO $ listDirectory (testCurrentDir env repo_dir) + forM_ pkgs $ \pkg -> do + let srcPath = testCurrentDir env repo_dir pkg + let sdistPath = package_dir pkg <.> "tar.gz" - liftIO $ createDirectoryIfMissing True packageDir - liftIO $ createDirectoryIfMissing True keysDir + let PackageIdentifier{pkgName = pn, pkgVersion = pv} = fromJust (simpleParsec pkg) + idxPath = index_dir unPackageName pn prettyShow pv unPackageName pn <.> "cabal" - -- 2. Create tarballs - entries <- liftIO $ getDirectoryContents (testCurrentDir env repoDir) - forM_ entries $ \entry -> do - let srcPath = testCurrentDir env repoDir entry - let destPath = packageDir entry - isPreferredVersionsFile <- liftIO $ - -- validate this is the "magic" 'preferred-versions' file - -- and perform a sanity-check whether this is actually a file - -- and not a package that happens to have the same name. - if entry == "preferred-versions" - then doesFileExist srcPath - else return False - case entry of - '.' : _ -> return () - _ - | isPreferredVersionsFile -> - liftIO $ copyFile srcPath destPath - | otherwise -> - archiveTo srcPath (destPath <.> "tar.gz") + srcPath `archiveTo` sdistPath + + -- When hackage-repo-tool extracts the cabal file from the tarball, it does carry + -- over the timestamp; so what ends up in the index is the time of this operation. + -- + -- We extract the cabal file ourselves carrying over the modification time. + -- hackage-repo-tool would re-extract the cabal file if the sdist is newer, to + -- avoid this possibility, we apply the same modification time to the sdist. + liftIO $ do + createDirectoryIfMissing True (takeDirectory idxPath) + copyFileWithMetadata (srcPath unPackageName pn <.> "cabal") idxPath - -- 3. Create keys and bootstrap repository - hackageRepoTool "create-keys" $ ["--keys", keysDir ] - hackageRepoTool "bootstrap" $ ["--keys", keysDir, "--repo", workDir] + ts <- System.Directory.getModificationTime (srcPath unPackageName pn <.> "cabal") + System.Directory.setModificationTime sdistPath ts - -- 4. Wire it up in .cabal/config + -- 5. Update repository + hackageRepoTool "update" ["--keys", testKeysDir env, "--repo", testRepoDir env] + + -- 6. Wire it up in .cabal/config let package_cache = testCabalDir env "packages" - -- In the following we launch a python http server to serve the remote - -- repository. When the http server is ready we proceed with the tests. - -- NOTE 1: it's important that both the http server and cabal use the - -- same hostname ("localhost"), otherwise there could be a mismatch - -- (depending on the details of the host networking settings). - -- NOTE 2: here we use a fixed port (8000). This can cause problems in - -- case multiple tests are running concurrently or other another - -- process on the developer machine is using the same port. - liftIO $ do - appendFile (testUserCabalConfigFile env) $ - unlines [ "repository repository.localhost" - , " url: http://localhost:8000/" - , " secure: True" - , " root-keys:" - , " key-threshold: 0" - , "remote-repo-cache: " ++ package_cache ] - putStrLn $ testUserCabalConfigFile env - putStrLn =<< readFile (testUserCabalConfigFile env) - - withAsync - (flip runReaderT env $ python3 ["-m", "http.server", "-d", workDir, "--bind", "localhost", "8000"]) - (\_ -> do - -- wait for the python webserver to come up with a exponential - -- backoff starting from 50ms, up to a maximum wait of 60s - _ <- waitTcpVerbose putStrLn (limitRetriesByCumulativeDelay 60000000 $ exponentialBackoff 50000) "localhost" "8000" - runReaderT m (env { testHaveRepo = True })) + liftIO $ appendFile (testUserCabalConfigFile env) + $ unlines [ "repository test-local-repo" + , " url: file:" ++ testRepoDir env + , " secure: True" + , " root-keys: " ++ unwords keyIds + , "remote-repo-cache: " ++ package_cache ] + -- 6. Create local directories (TODO: this is a bug #4136, once you + -- fix that this can be removed) + liftIO $ createDirectoryIfMissing True (package_cache "test-local-repo") + + -- 7. Profit + withReaderT (\env' -> env' { testHaveRepo = True }) m + +setModificationTime :: FilePath -> UTCTime -> TestM () +setModificationTime fp ts = do + env <- getTestEnv + liftIO $ System.Directory.setModificationTime (testCurrentDir env fp) ts + +getModificationTime :: FilePath -> TestM UTCTime +getModificationTime fp = do + env <- getTestEnv + liftIO $ System.Directory.getModificationTime (testCurrentDir env fp) ------------------------------------------------------------------------ -- * Subprocess run results @@ -1021,14 +1017,6 @@ ghc' args = do recordHeader ["ghc"] runProgramM ghcProgram args Nothing -python3 :: [String] -> TestM () -python3 args = void $ python3' args - -python3' :: [String] -> TestM Result -python3' args = do - recordHeader ["python3"] - runProgramM python3Program args Nothing - -- | If a test needs to modify or write out source files, it's -- necessary to make a hermetic copy of the source files to operate -- on. This function arranges for this to be done.