diff --git a/.github/workflows/validate.yml b/.github/workflows/validate.yml index db36f35e21a..11fbc565d84 100644 --- a/.github/workflows/validate.yml +++ b/.github/workflows/validate.yml @@ -86,6 +86,17 @@ jobs: cabal install cabal-plan --constraint='cabal-plan +exe' echo "$HOME/.cabal/bin" >> $GITHUB_PATH + # The tool is not essential to the rest of the test suite. If + # hackage-repo-tool is not present, any test that requires it will + # be skipped. + # We want to keep this in the loop but we don't want to fail if + # hackage-repo-tool breaks or fails to support a newer GHC version. + - name: Install hackage-repo-tool + continue-on-error: true + run: | + cd $(mktemp -d) + cabal install hackage-repo-tool + # Needed by cabal-testsuite/PackageTests/Configure/setup.test.hs - name: Install Autotools if: runner.os == 'macOS' diff --git a/cabal-install/src/Distribution/Client/CmdUpdate.hs b/cabal-install/src/Distribution/Client/CmdUpdate.hs index 693ae3cba9c..305ceef7226 100644 --- a/cabal-install/src/Distribution/Client/CmdUpdate.hs +++ b/cabal-install/src/Distribution/Client/CmdUpdate.hs @@ -47,7 +47,6 @@ import Distribution.Simple.Utils ( die', notice, wrapText, writeFileAtomic, noticeNoWrap, warn ) import Distribution.Verbosity ( normal, lessVerbose ) -import Distribution.Client.IndexUtils.Timestamp import Distribution.Client.IndexUtils.IndexState import Distribution.Client.IndexUtils ( updateRepoIndexCache, Index(..), writeIndexTimestamp @@ -203,7 +202,8 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do 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 let rname = remoteRepoName (repoRemote repo) -- Update cabal's internal index as well so that it's not out of sync @@ -214,20 +214,20 @@ updateRepo verbosity _updateFlags repoCtxt (repo, indexState) = do 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) + "Package list of " ++ prettyShow rname ++ " is up to date." Sec.HasUpdates -> do updateRepoIndexCache verbosity index - new_ts <- currentIndexTimestamp (lessVerbose verbosity) repoCtxt repo noticeNoWrap verbosity $ - "Updated package list of " ++ prettyShow rname ++ - " to the index-state " ++ prettyShow (IndexStateTime new_ts) - - -- TODO: This will print multiple times if there are multiple - -- repositories: main problem is we don't have a way of updating - -- a specific repo. Once we implement that, update this. - when (current_ts /= nullTimestamp) $ - noticeNoWrap verbosity $ - "To revert to previous state run:\n" ++ - " cabal v2-update '" ++ prettyShow (UpdateRequest rname (IndexStateTime current_ts)) ++ "'\n" + "Package list of " ++ prettyShow rname ++ " has been updated." + + noticeNoWrap verbosity $ + "The index-state is set to " ++ prettyShow (IndexStateTime new_ts) ++ "." + + -- TODO: This will print multiple times if there are multiple + -- repositories: main problem is we don't have a way of updating + -- a specific repo. Once we implement that, update this. + when (new_ts /= current_ts) $ + noticeNoWrap verbosity $ + "To revert to previous state run:\n" ++ + " cabal v2-update '" ++ prettyShow (UpdateRequest rname (IndexStateTime current_ts)) ++ "'\n" \ No newline at end of file diff --git a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/repo/pkg-1.0/pkg.cabal b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/repo/pkg-1.0/pkg.cabal new file mode 100644 index 00000000000..356f1816e3b --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/repo/pkg-1.0/pkg.cabal @@ -0,0 +1,8 @@ +name: pkg +version: 1.0 +build-type: Simple +cabal-version: >= 1.2 + +executable my-exe + main-is: Main.hs + build-depends: base diff --git a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out new file mode 100644 index 00000000000..ce06724dbaa --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out @@ -0,0 +1,20 @@ +# cabal update +Warning: Caught exception during _mirrors lookup:user error (res_query(3) failed) +Warning: No mirrors found for http://localhost:8000/ +Downloading the latest package list from repository.localhost +Package list of repository.localhost has been updated. +The index-state is set to 2022-01-28T02:36:41Z. +To revert to previous state run: + cabal v2-update 'repository.localhost,' +# 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' +# 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. +To revert to previous state run: + cabal v2-update 'repository.localhost,2016-09-24T17:47:48Z' diff --git a/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs new file mode 100644 index 00000000000..047d70b29c1 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs @@ -0,0 +1,9 @@ +import Test.Cabal.Prelude + +main = cabalTest $ withRemoteRepo "repo" $ do + -- This test causes a warning about missing mirrors, the warning is + -- included in the expected output to make the test pass but it's not + -- part of the test expectations. + cabal "update" ["repository.localhost,2022-01-28T02:36:41Z"] + cabal "update" ["repository.localhost,2016-09-24T17:47:48Z"] + cabal "update" ["repository.localhost,2022-01-28T02:36:41Z"] diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 7a93a7ebe6c..841202a1890 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -67,10 +67,12 @@ library , directory ^>= 1.2.0.1 || ^>= 1.3.0.0 , exceptions ^>= 0.10.0 , filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 + , network-wait ^>= 0.1.2.0 , optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 , process ^>= 1.2.1.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0 , regex-base ^>= 0.94.0.1 , regex-tdfa ^>= 1.2.3.1 || ^>=1.3.1.0 + , retry ^>= 0.9.1.0 , array ^>= 0.4.0.1 || ^>= 0.5.0.0 , temporary ^>= 1.3 , text ^>= 1.2.3.1 diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index 376d144e606..eb4f6965189 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -18,6 +18,7 @@ module Test.Cabal.Monad ( gitProgram, cabalProgram, diffProgram, + python3Program, -- * The test environment TestEnv(..), getTestEnv, @@ -215,6 +216,9 @@ cabalProgram = (simpleProgram "cabal") { diffProgram :: Program diffProgram = simpleProgram "diff" +python3Program :: Program +python3Program = simpleProgram "python3" + -- | Run a test in the test monad according to program's arguments. runTestM :: String -> TestM a -> IO a runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do @@ -229,7 +233,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do -- Add test suite specific programs let program_db0 = addKnownPrograms - ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram] ++ builtinPrograms) + ([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram, python3Program] ++ 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 2bc4e0bd7a0..6db2654c2da 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -63,6 +63,8 @@ import System.FilePath ((), takeExtensions, takeDrive, takeDirectory, normali import Control.Concurrent (threadDelay) import qualified Data.Char as Char import System.Directory (getTemporaryDirectory, getCurrentDirectory, canonicalizePath, copyFile, copyFile, doesDirectoryExist, doesFileExist, createDirectoryIfMissing, getDirectoryContents) +import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay) +import Network.Wait (waitTcpVerbose) #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -564,6 +566,79 @@ withRepo repo_dir m = do where 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 + + -- 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 + + env <- getTestEnv + + let workDir = testRepoDir env + + -- 1. Initialize repo and repo_keys directory + let keysDir = workDir "keys" + let packageDir = workDir "package" + + liftIO $ createDirectoryIfMissing True packageDir + liftIO $ createDirectoryIfMissing True keysDir + + -- 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") + + -- 3. Create keys and bootstrap repository + hackageRepoTool "create-keys" $ ["--keys", keysDir ] + hackageRepoTool "bootstrap" $ ["--keys", keysDir, "--repo", workDir] + + -- 4. Wire it up in .cabal/config + -- TODO: libify this + let package_cache = testCabalDir env "packages" + + 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 + (runReaderT (python3 ["-m", "http.server", "-d", workDir, "--bind", "localhost", "8000"]) env) + (\_ -> 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 })) + + ------------------------------------------------------------------------ -- * Subprocess run results @@ -911,6 +986,14 @@ 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. diff --git a/cabal-testsuite/src/Test/Cabal/Run.hs b/cabal-testsuite/src/Test/Cabal/Run.hs index 5ebcf8971e3..6c06dec91d7 100644 --- a/cabal-testsuite/src/Test/Cabal/Run.hs +++ b/cabal-testsuite/src/Test/Cabal/Run.hs @@ -69,7 +69,8 @@ runAction _verbosity mb_cwd env_overrides path0 args input action = do , std_out = UseHandle writeh , std_err = UseHandle writeh } - (stdin_h, _, _, procHandle) <- createProcess prc + + withCreateProcess prc $ \stdin_h _ _ procHandle -> do case input of Just x -> diff --git a/changelog.d/pr-7934 b/changelog.d/pr-7934 new file mode 100644 index 00000000000..239f7dd2842 --- /dev/null +++ b/changelog.d/pr-7934 @@ -0,0 +1,3 @@ +synopsis: Fix the timestamp shown during cabal update +packages: cabal-install +prs: #7934