From 171d5a4bb3b3e031deef5b8f2b84d5a150ec362a Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 27 Jan 2022 21:46:39 +0800 Subject: [PATCH 01/11] Fix the timestamp shown during cabal update Passing an index-state timestamp to cabal update currently makes it write a message saying the index has been updated to the *previous* timestamp. $ cabal update hackage.haskell.org,2016-09-24T17:47:48Z Downloading the latest package list from hackage.haskell.org Package list of hackage.haskell.org is up to date at index-state 2022-01-27T12:59:23Z This is because of a confusion between downloading the index and setting the index state. These are independent actions. This patch makes separates the two messages (updating the index and updating the index-state timestamp) and makes sure the right timestamp is printed. --- .../src/Distribution/Client/CmdUpdate.hs | 30 +++++++++---------- changelog.d/pr-7934 | 3 ++ 2 files changed, 18 insertions(+), 15 deletions(-) create mode 100644 changelog.d/pr-7934 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/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 From a5fdd34f7b366fe41b262314d8bdf9607c831bc5 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Fri, 28 Jan 2022 11:47:45 +0800 Subject: [PATCH 02/11] Add test case for cabal update message --- .../NewUpdate/update_index_state.out | 18 ++++++++++++++++++ .../NewUpdate/update_index_state.test.hs | 14 ++++++++++++++ 2 files changed, 32 insertions(+) create mode 100644 cabal-testsuite/PackageTests/NewUpdate/update_index_state.out create mode 100644 cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs diff --git a/cabal-testsuite/PackageTests/NewUpdate/update_index_state.out b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.out new file mode 100644 index 00000000000..c7903ea9f0c --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.out @@ -0,0 +1,18 @@ +# cabal update +Downloading the latest package list from hackage.haskell.org +Package list of hackage.haskell.org has been updated. +The index-state is set to 2022-01-28T02:36:41Z. +To revert to previous state run: + cabal v2-update 'hackage.haskell.org,' +# cabal update +Downloading the latest package list from hackage.haskell.org +Package list of hackage.haskell.org is up to date. +The index-state is set to 2016-09-24T17:47:48Z. +To revert to previous state run: + cabal v2-update 'hackage.haskell.org,2022-01-28T02:36:41Z' +# cabal update +Downloading the latest package list from hackage.haskell.org +Package list of hackage.haskell.org is up to date. +The index-state is set to 2022-01-28T02:36:41Z. +To revert to previous state run: + cabal v2-update 'hackage.haskell.org,2016-09-24T17:47:48Z' diff --git a/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs new file mode 100644 index 00000000000..eb3817d99d5 --- /dev/null +++ b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs @@ -0,0 +1,14 @@ +import Test.Cabal.Prelude +main = cabalTest $ do + env <- getTestEnv + + liftIO $ appendFile (testUserCabalConfigFile env) + $ unlines [ "repository hackage.haskell.org" + , " url: http://hackage.haskell.org/" + ] + liftIO $ print $ testUserCabalConfigFile env + liftIO $ print =<< readFile (testUserCabalConfigFile env) + + cabal "update" ["hackage.haskell.org,2022-01-28T02:36:41Z"] + cabal "update" ["hackage.haskell.org,2016-09-24T17:47:48Z"] + cabal "update" ["hackage.haskell.org,2022-01-28T02:36:41Z"] From 4af65bfb7c6fe4a92fe36c47d19b6d336ee28bee Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 1 Feb 2022 13:43:15 +0800 Subject: [PATCH 03/11] Enable testing against a local remote repository - Introduce `withRemoteRepo`. The function `withRemoteRepo` takes a folder with packages (in the same way as `withRepo` and presents it to cabal as a secure remote repository. - Convert NewUpewte/UpdateIndexState test from using Hackage to withRemoteRepo. --- .../UpdateIndexState/repo/pkg-1.0/pkg.cabal | 8 ++ .../UpdateIndexState/update-index-state.out | 20 +++++ .../update-index-state.test.hs | 9 +++ .../NewUpdate/update_index_state.out | 18 ----- .../NewUpdate/update_index_state.test.hs | 14 ---- cabal-testsuite/src/Test/Cabal/Monad.hs | 6 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 77 +++++++++++++++++++ cabal-testsuite/src/Test/Cabal/Run.hs | 3 +- 8 files changed, 121 insertions(+), 34 deletions(-) create mode 100644 cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/repo/pkg-1.0/pkg.cabal create mode 100644 cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out create mode 100644 cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs delete mode 100644 cabal-testsuite/PackageTests/NewUpdate/update_index_state.out delete mode 100644 cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs 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/PackageTests/NewUpdate/update_index_state.out b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.out deleted file mode 100644 index c7903ea9f0c..00000000000 --- a/cabal-testsuite/PackageTests/NewUpdate/update_index_state.out +++ /dev/null @@ -1,18 +0,0 @@ -# cabal update -Downloading the latest package list from hackage.haskell.org -Package list of hackage.haskell.org has been updated. -The index-state is set to 2022-01-28T02:36:41Z. -To revert to previous state run: - cabal v2-update 'hackage.haskell.org,' -# cabal update -Downloading the latest package list from hackage.haskell.org -Package list of hackage.haskell.org is up to date. -The index-state is set to 2016-09-24T17:47:48Z. -To revert to previous state run: - cabal v2-update 'hackage.haskell.org,2022-01-28T02:36:41Z' -# cabal update -Downloading the latest package list from hackage.haskell.org -Package list of hackage.haskell.org is up to date. -The index-state is set to 2022-01-28T02:36:41Z. -To revert to previous state run: - cabal v2-update 'hackage.haskell.org,2016-09-24T17:47:48Z' diff --git a/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs b/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs deleted file mode 100644 index eb3817d99d5..00000000000 --- a/cabal-testsuite/PackageTests/NewUpdate/update_index_state.test.hs +++ /dev/null @@ -1,14 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - env <- getTestEnv - - liftIO $ appendFile (testUserCabalConfigFile env) - $ unlines [ "repository hackage.haskell.org" - , " url: http://hackage.haskell.org/" - ] - liftIO $ print $ testUserCabalConfigFile env - liftIO $ print =<< readFile (testUserCabalConfigFile env) - - cabal "update" ["hackage.haskell.org,2022-01-28T02:36:41Z"] - cabal "update" ["hackage.haskell.org,2016-09-24T17:47:48Z"] - cabal "update" ["hackage.haskell.org,2022-01-28T02:36:41Z"] 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..d94ead008b4 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -564,6 +564,75 @@ 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 + + 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]) env) + (\_ -> do + threadDelay 500000 + runReaderT m (env { testHaveRepo = True })) + + ------------------------------------------------------------------------ -- * Subprocess run results @@ -911,6 +980,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 -> From 6581a595080aa7d8ad12661ff2935972af62243f Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Tue, 1 Feb 2022 16:52:12 +0800 Subject: [PATCH 04/11] Skip withRemoteRepo if hackageRepoToolProgram is not available --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index d94ead008b4..a1863bf7663 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -575,6 +575,8 @@ withRemoteRepo repoDir m = do -- 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 From d007aac81f96c9ffaf500f2c74f591b4e49d5b2c Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Fri, 11 Feb 2022 08:38:46 +0800 Subject: [PATCH 05/11] Install hackage-repo-tool in CI --- .github/workflows/validate.yml | 11 +++++++++++ 1 file changed, 11 insertions(+) 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' From ac9d6aab7ccf2ecb5dd2fe939dadf68da9ecc5ee Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 5 May 2022 14:11:54 +0800 Subject: [PATCH 06/11] Avoid threadDeleay in withRemoteRepo Note: as it is, this won't work on GHC 8.2 because network-wait-0.1.1.0 doesn't support it. Hopefully we can resolve this soon. --- cabal-testsuite/cabal-testsuite.cabal | 2 ++ cabal-testsuite/src/Test/Cabal/Prelude.hs | 4 +++- 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index 7a93a7ebe6c..df80d7dab77 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.1.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/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index a1863bf7663..a5341312c96 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 (constantDelay, limitRetries) +import Network.Wait (waitTcp) #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -631,7 +633,7 @@ withRemoteRepo repoDir m = do withAsync (runReaderT (python3 ["-m", "http.server", "-d", workDir]) env) (\_ -> do - threadDelay 500000 + waitTcp (constantDelay 50000 <> limitRetries 5) "localhost" "8000" runReaderT m (env { testHaveRepo = True })) From 6310e9f27c98271420a4aa91d8c97067fad7689c Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 5 May 2022 20:31:00 +0800 Subject: [PATCH 07/11] Bump network-wait version. Thanks @mbg! --- cabal-testsuite/cabal-testsuite.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index df80d7dab77..841202a1890 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -67,7 +67,7 @@ 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.1.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 From b3b2f3e127f0bb56fc7ee3e9ab9bfe6359901561 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 5 May 2022 21:01:07 +0800 Subject: [PATCH 08/11] Replace <> with mappend to please ghc 8.0 --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index a5341312c96..8e90aa4a728 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -633,7 +633,7 @@ withRemoteRepo repoDir m = do withAsync (runReaderT (python3 ["-m", "http.server", "-d", workDir]) env) (\_ -> do - waitTcp (constantDelay 50000 <> limitRetries 5) "localhost" "8000" + waitTcp (constantDelay 50000 `mappend` limitRetries 5) "localhost" "8000" runReaderT m (env { testHaveRepo = True })) From 8145f8cb2719494a94a710fd71bf6c05320256f1 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 5 May 2022 21:57:47 +0800 Subject: [PATCH 09/11] Change waiting strategy --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 8e90aa4a728..7e7edb1c8bf 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -63,8 +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 (constantDelay, limitRetries) -import Network.Wait (waitTcp) +import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay) +import Network.Wait (waitTcpVerbose) #ifndef mingw32_HOST_OS import Control.Monad.Catch ( bracket_ ) @@ -633,7 +633,9 @@ withRemoteRepo repoDir m = do withAsync (runReaderT (python3 ["-m", "http.server", "-d", workDir]) env) (\_ -> do - waitTcp (constantDelay 50000 `mappend` limitRetries 5) "localhost" "8000" + -- wait for the python webserver to come up with a exponential + -- backoff starting from 50ms, up to a maximum wait of 10s + waitTcpVerbose putStrLn (limitRetriesByCumulativeDelay 10000000 $ exponentialBackoff 50000) "localhost" "8000" runReaderT m (env { testHaveRepo = True })) From 9a55a0fd3e35fd408f8d13c78f7cc4f25abee9e8 Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Thu, 5 May 2022 23:09:51 +0800 Subject: [PATCH 10/11] Wait more --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 7e7edb1c8bf..d7b73cd9a05 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -634,8 +634,8 @@ withRemoteRepo repoDir m = do (runReaderT (python3 ["-m", "http.server", "-d", workDir]) env) (\_ -> do -- wait for the python webserver to come up with a exponential - -- backoff starting from 50ms, up to a maximum wait of 10s - waitTcpVerbose putStrLn (limitRetriesByCumulativeDelay 10000000 $ exponentialBackoff 50000) "localhost" "8000" + -- backoff starting from 50ms, up to a maximum wait of 60s + waitTcpVerbose putStrLn (limitRetriesByCumulativeDelay 60000000 $ exponentialBackoff 50000) "localhost" "8000" runReaderT m (env { testHaveRepo = True })) From 00c97769f619853e3d84a872cf09eff4ef7d196a Mon Sep 17 00:00:00 2001 From: Andrea Bedini Date: Fri, 6 May 2022 08:18:37 +0800 Subject: [PATCH 11/11] Explicit is better than implicit --- cabal-testsuite/src/Test/Cabal/Prelude.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index d7b73cd9a05..6db2654c2da 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -631,7 +631,7 @@ withRemoteRepo repoDir m = do putStrLn =<< readFile (testUserCabalConfigFile env) withAsync - (runReaderT (python3 ["-m", "http.server", "-d", workDir]) env) + (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