Commit 09fc2a72 authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Support for configuring repositories in tests.



This is a pretty important new feature in the test suite, which
is to construct a remote repository on the fly as part of the
test suite.

The general principle is that you create a directory full of folders
for all of the packages you want available in the repo, and then
the 'withRepo' function will initialize this into a secure repo
you can do tests with.

Fixes #4016.

Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 59f79433
......@@ -24,6 +24,9 @@ module Test.Cabal.Monad (
testHomeDir,
testSandboxDir,
testSandboxConfigFile,
testRepoDir,
testKeysDir,
testUserCabalConfigFile,
-- * Skipping tests
skip,
skipIf,
......@@ -70,6 +73,7 @@ import Options.Applicative
data CommonArgs = CommonArgs {
argCabalInstallPath :: Maybe FilePath,
argGhcPath :: Maybe FilePath,
argHackageRepoToolPath :: FilePath,
argSkipSetupTests :: Bool
}
......@@ -86,12 +90,19 @@ commonArgParser = CommonArgs
<> long "with-ghc"
<> metavar "PATH"
))
<*> option str
( help "Path to hackage-repo-tool to use for repository manipulation"
<> long "with-hackage-repo-tool"
<> metavar "PATH"
<> value "hackage-repo-tool"
)
<*> switch (long "skip-setup-tests" <> help "Skip setup tests")
renderCommonArgs :: CommonArgs -> [String]
renderCommonArgs args =
maybe [] (\x -> ["--with-cabal", x]) (argCabalInstallPath args) ++
maybe [] (\x -> ["--with-ghc", x]) (argGhcPath args) ++
["--with-hackage-repo-tool", argHackageRepoToolPath args] ++
(if argSkipSetupTests args then ["--skip-setup-tests"] else [])
data TestArgs = TestArgs {
......@@ -201,6 +212,7 @@ runTestM m = do
testScriptEnv = senv,
testSetupPath = dist_dir </> "setup" </> "setup",
testCabalInstallPath = argCabalInstallPath (testCommonArgs args),
testHackageRepoToolPath = argHackageRepoToolPath (testCommonArgs args),
testSkipSetupTests = argSkipSetupTests (testCommonArgs args),
testEnvironment =
-- Try to avoid Unicode output
......@@ -211,6 +223,7 @@ runTestM m = do
testRelativeCurrentDir = ".",
testHavePackageDb = False,
testHaveSandbox = False,
testHaveRepo = False,
testCabalInstallAsSetup = False,
testCabalProjectFile = "cabal.project",
testPlan = Nothing
......@@ -225,9 +238,8 @@ runTestM m = do
-- NOT want to assume for these tests (no test should
-- hit Hackage.)
liftIO $ createDirectoryIfMissing True (testHomeDir env </> ".cabal")
-- TODO: This doesn't work on Windows
ghc_path <- programPathM ghcProgram
liftIO $ writeFile (testHomeDir env </> ".cabal" </> "config")
liftIO $ writeFile (testUserCabalConfigFile env)
$ unlines [ "with-compiler: " ++ ghc_path ]
requireProgramM :: Program -> TestM ConfiguredProgram
......@@ -274,8 +286,12 @@ data TestEnv = TestEnv
-- | Setup script path
, testSetupPath :: FilePath
-- | cabal-install path (or Nothing if we are not testing
-- cabal-install)
-- cabal-install). NB: This does NOT default to @cabal@ in PATH as
-- this is unlikely to be the cabal you want to test.
, testCabalInstallPath :: Maybe FilePath
-- | hackage-repo-tool path (defaults to hackage-repo-tool found in
-- PATH)
, testHackageRepoToolPath :: FilePath
-- | Skip Setup tests?
, testSkipSetupTests :: Bool
......@@ -291,6 +307,8 @@ data TestEnv = TestEnv
, testHavePackageDb :: Bool
-- | Says if we're working in a sandbox
, testHaveSandbox :: Bool
-- | Says if we've setup a repository
, testHaveRepo :: Bool
-- | Says if we're testing cabal-install as setup
, testCabalInstallAsSetup :: Bool
-- | Says what cabal.project file to use (probed)
......@@ -344,3 +362,17 @@ testSandboxDir env = testWorkDir env </> "sandbox"
-- | The sandbox configuration file
testSandboxConfigFile :: TestEnv -> FilePath
testSandboxConfigFile env = testWorkDir env </> "cabal.sandbox.config"
-- | The absolute prefix of our local secure repository, which we
-- use to simulate "external" packages
testRepoDir :: TestEnv -> FilePath
testRepoDir env = testWorkDir env </> "repo"
-- | The absolute prefix of keys for the test.
testKeysDir :: TestEnv -> FilePath
testKeysDir env = testWorkDir env </> "keys"
-- | The user cabal config file
-- TODO: Not obviously working on Windows
testUserCabalConfigFile :: TestEnv -> FilePath
testUserCabalConfigFile env = testHomeDir env </> ".cabal" </> "config"
......@@ -226,6 +226,8 @@ cabal' cmd args = do
-- Sandboxes manage dist dir
| testHaveSandbox env
= [ ]
| cmd == "update"
= [ ]
-- new-build commands are affected by testCabalProjectFile
| "new-" `isPrefixOf` cmd
= [ "--builddir", testDistDir env
......@@ -382,6 +384,111 @@ runInstalledExe' exe_name args = do
shell :: String -> [String] -> TestM Result
shell exe args = runM exe args
------------------------------------------------------------------------
-- * Repository manipulation
-- Workflows we support:
-- 1. Test comes with some packages (directories in repository) which
-- should be in the repository and available for depsolving/installing
-- into global store.
--
-- Workflows we might want to support in the future
-- * Regression tests may want to test on Hackage index. They will
-- operate deterministically as they will be pinned to a timestamp.
-- (But should we allow this? Have to download the tarballs in that
-- case. Perhaps dep solver only!)
-- * We might sdist a local package, and then upload it to the
-- repository
-- * Some of our tests involve old versions of Cabal. This might
-- be one of the rare cases where we're willing to grab the entire
-- tarball.
--
-- Properties we want to hold:
-- 1. Tests can be run offline. No dependence on hackage.haskell.org
-- beyond what we needed to actually get the build of Cabal working
-- itself
-- 2. Tests are deterministic. Updates to Hackage should not cause
-- tests to fail. (OTOH, it's good to run tests on most recent
-- Hackage index; some sort of canary test which is run nightly.
-- Point is it should NOT be tied to cabal source code.)
--
-- Technical notes:
-- * We depend on hackage-repo-tool binary. It would better if it was
-- libified into hackage-security but this has not been done yet.
--
hackageRepoTool :: String -> [String] -> TestM ()
hackageRepoTool cmd args = void $ hackageRepoTool' cmd args
hackageRepoTool' :: String -> [String] -> TestM Result
hackageRepoTool' cmd args = do
env <- getTestEnv
r <- runM (testHackageRepoToolPath env) (cmd : args)
record r
_ <- requireSuccess r
return r
tar :: [String] -> TestM ()
tar args = void $ tar' args
tar' :: [String] -> TestM Result
tar' = runProgramM tarProgram
-- | Creates a tarball of a directory, such that if you
-- archive the directory "/foo/bar/baz" to "mine.tgz", @tar tf@ reports
-- @baz/file1@, @baz/file2@, etc.
archiveTo :: FilePath -> FilePath -> TestM ()
src `archiveTo` dst = do
-- TODO: Consider using the @tar@ library?
let (src_parent, src_dir) = splitFileName src
-- TODO: --format ustar, like createArchive?
tar ["-czf", dst, "-C", src_parent, src_dir]
infixr 4 `archiveTo`
-- | Given a directory (relative to the 'testCurrentDir') containing
-- a series of directories representing packages, generate an
-- external repository corresponding to all of these packages
withRepo :: FilePath -> TestM a -> TestM a
withRepo repo_dir m = do
env <- getTestEnv
-- 1. Generate keys
hackageRepoTool "create-keys" ["--keys", testKeysDir env]
-- 2. Initialize repo directory
let package_dir = testRepoDir env </> "package"
liftIO $ createDirectoryIfMissing True (testRepoDir env </> "index")
liftIO $ createDirectoryIfMissing True package_dir
-- 3. Create tarballs
pkgs <- liftIO $ getDirectoryContents (testCurrentDir env </> repo_dir)
forM_ pkgs $ \pkg -> do
case pkg of
'.':_ -> return ()
_ -> testCurrentDir env </> repo_dir </> pkg
`archiveTo`
package_dir </> pkg <.> "tar.gz"
-- 4. Initialize repository
hackageRepoTool "bootstrap" ["--keys", testKeysDir env, "--repo", testRepoDir env]
-- 5. Wire it up in .cabal/config
-- TODO: libify this
let package_cache = testHomeDir env </> ".cabal" </> "packages"
liftIO $ appendFile (testUserCabalConfigFile env)
$ unlines [ "repository test-local-repo"
, " url: file:" ++ testRepoDir env
, " secure: True"
-- TODO: Hypothetically, we could stick in the
-- correct key here
, " root-keys: "
, " key-threshold: 0"
, "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. Update our local index
cabal "update" []
-- 8. Profit
withReaderT (\env' -> env' { testHaveRepo = True }) m
-- TODO: Arguably should undo everything when we're done...
------------------------------------------------------------------------
-- * Subprocess run results
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment