Skip to content

Commit 09fc2a7

Browse files
committed
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: Edward Z. Yang <[email protected]>
1 parent 59f7943 commit 09fc2a7

File tree

2 files changed

+142
-3
lines changed

2 files changed

+142
-3
lines changed

cabal-testsuite/Test/Cabal/Monad.hs

Lines changed: 35 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,6 +24,9 @@ module Test.Cabal.Monad (
2424
testHomeDir,
2525
testSandboxDir,
2626
testSandboxConfigFile,
27+
testRepoDir,
28+
testKeysDir,
29+
testUserCabalConfigFile,
2730
-- * Skipping tests
2831
skip,
2932
skipIf,
@@ -70,6 +73,7 @@ import Options.Applicative
7073
data CommonArgs = CommonArgs {
7174
argCabalInstallPath :: Maybe FilePath,
7275
argGhcPath :: Maybe FilePath,
76+
argHackageRepoToolPath :: FilePath,
7377
argSkipSetupTests :: Bool
7478
}
7579

@@ -86,12 +90,19 @@ commonArgParser = CommonArgs
8690
<> long "with-ghc"
8791
<> metavar "PATH"
8892
))
93+
<*> option str
94+
( help "Path to hackage-repo-tool to use for repository manipulation"
95+
<> long "with-hackage-repo-tool"
96+
<> metavar "PATH"
97+
<> value "hackage-repo-tool"
98+
)
8999
<*> switch (long "skip-setup-tests" <> help "Skip setup tests")
90100

91101
renderCommonArgs :: CommonArgs -> [String]
92102
renderCommonArgs args =
93103
maybe [] (\x -> ["--with-cabal", x]) (argCabalInstallPath args) ++
94104
maybe [] (\x -> ["--with-ghc", x]) (argGhcPath args) ++
105+
["--with-hackage-repo-tool", argHackageRepoToolPath args] ++
95106
(if argSkipSetupTests args then ["--skip-setup-tests"] else [])
96107

97108
data TestArgs = TestArgs {
@@ -201,6 +212,7 @@ runTestM m = do
201212
testScriptEnv = senv,
202213
testSetupPath = dist_dir </> "setup" </> "setup",
203214
testCabalInstallPath = argCabalInstallPath (testCommonArgs args),
215+
testHackageRepoToolPath = argHackageRepoToolPath (testCommonArgs args),
204216
testSkipSetupTests = argSkipSetupTests (testCommonArgs args),
205217
testEnvironment =
206218
-- Try to avoid Unicode output
@@ -211,6 +223,7 @@ runTestM m = do
211223
testRelativeCurrentDir = ".",
212224
testHavePackageDb = False,
213225
testHaveSandbox = False,
226+
testHaveRepo = False,
214227
testCabalInstallAsSetup = False,
215228
testCabalProjectFile = "cabal.project",
216229
testPlan = Nothing
@@ -225,9 +238,8 @@ runTestM m = do
225238
-- NOT want to assume for these tests (no test should
226239
-- hit Hackage.)
227240
liftIO $ createDirectoryIfMissing True (testHomeDir env </> ".cabal")
228-
-- TODO: This doesn't work on Windows
229241
ghc_path <- programPathM ghcProgram
230-
liftIO $ writeFile (testHomeDir env </> ".cabal" </> "config")
242+
liftIO $ writeFile (testUserCabalConfigFile env)
231243
$ unlines [ "with-compiler: " ++ ghc_path ]
232244

233245
requireProgramM :: Program -> TestM ConfiguredProgram
@@ -274,8 +286,12 @@ data TestEnv = TestEnv
274286
-- | Setup script path
275287
, testSetupPath :: FilePath
276288
-- | cabal-install path (or Nothing if we are not testing
277-
-- cabal-install)
289+
-- cabal-install). NB: This does NOT default to @cabal@ in PATH as
290+
-- this is unlikely to be the cabal you want to test.
278291
, testCabalInstallPath :: Maybe FilePath
292+
-- | hackage-repo-tool path (defaults to hackage-repo-tool found in
293+
-- PATH)
294+
, testHackageRepoToolPath :: FilePath
279295
-- | Skip Setup tests?
280296
, testSkipSetupTests :: Bool
281297

@@ -291,6 +307,8 @@ data TestEnv = TestEnv
291307
, testHavePackageDb :: Bool
292308
-- | Says if we're working in a sandbox
293309
, testHaveSandbox :: Bool
310+
-- | Says if we've setup a repository
311+
, testHaveRepo :: Bool
294312
-- | Says if we're testing cabal-install as setup
295313
, testCabalInstallAsSetup :: Bool
296314
-- | Says what cabal.project file to use (probed)
@@ -344,3 +362,17 @@ testSandboxDir env = testWorkDir env </> "sandbox"
344362
-- | The sandbox configuration file
345363
testSandboxConfigFile :: TestEnv -> FilePath
346364
testSandboxConfigFile env = testWorkDir env </> "cabal.sandbox.config"
365+
366+
-- | The absolute prefix of our local secure repository, which we
367+
-- use to simulate "external" packages
368+
testRepoDir :: TestEnv -> FilePath
369+
testRepoDir env = testWorkDir env </> "repo"
370+
371+
-- | The absolute prefix of keys for the test.
372+
testKeysDir :: TestEnv -> FilePath
373+
testKeysDir env = testWorkDir env </> "keys"
374+
375+
-- | The user cabal config file
376+
-- TODO: Not obviously working on Windows
377+
testUserCabalConfigFile :: TestEnv -> FilePath
378+
testUserCabalConfigFile env = testHomeDir env </> ".cabal" </> "config"

cabal-testsuite/Test/Cabal/Prelude.hs

Lines changed: 107 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -226,6 +226,8 @@ cabal' cmd args = do
226226
-- Sandboxes manage dist dir
227227
| testHaveSandbox env
228228
= [ ]
229+
| cmd == "update"
230+
= [ ]
229231
-- new-build commands are affected by testCabalProjectFile
230232
| "new-" `isPrefixOf` cmd
231233
= [ "--builddir", testDistDir env
@@ -382,6 +384,111 @@ runInstalledExe' exe_name args = do
382384
shell :: String -> [String] -> TestM Result
383385
shell exe args = runM exe args
384386

387+
------------------------------------------------------------------------
388+
-- * Repository manipulation
389+
390+
-- Workflows we support:
391+
-- 1. Test comes with some packages (directories in repository) which
392+
-- should be in the repository and available for depsolving/installing
393+
-- into global store.
394+
--
395+
-- Workflows we might want to support in the future
396+
-- * Regression tests may want to test on Hackage index. They will
397+
-- operate deterministically as they will be pinned to a timestamp.
398+
-- (But should we allow this? Have to download the tarballs in that
399+
-- case. Perhaps dep solver only!)
400+
-- * We might sdist a local package, and then upload it to the
401+
-- repository
402+
-- * Some of our tests involve old versions of Cabal. This might
403+
-- be one of the rare cases where we're willing to grab the entire
404+
-- tarball.
405+
--
406+
-- Properties we want to hold:
407+
-- 1. Tests can be run offline. No dependence on hackage.haskell.org
408+
-- beyond what we needed to actually get the build of Cabal working
409+
-- itself
410+
-- 2. Tests are deterministic. Updates to Hackage should not cause
411+
-- tests to fail. (OTOH, it's good to run tests on most recent
412+
-- Hackage index; some sort of canary test which is run nightly.
413+
-- Point is it should NOT be tied to cabal source code.)
414+
--
415+
-- Technical notes:
416+
-- * We depend on hackage-repo-tool binary. It would better if it was
417+
-- libified into hackage-security but this has not been done yet.
418+
--
419+
420+
hackageRepoTool :: String -> [String] -> TestM ()
421+
hackageRepoTool cmd args = void $ hackageRepoTool' cmd args
422+
423+
hackageRepoTool' :: String -> [String] -> TestM Result
424+
hackageRepoTool' cmd args = do
425+
env <- getTestEnv
426+
r <- runM (testHackageRepoToolPath env) (cmd : args)
427+
record r
428+
_ <- requireSuccess r
429+
return r
430+
431+
tar :: [String] -> TestM ()
432+
tar args = void $ tar' args
433+
434+
tar' :: [String] -> TestM Result
435+
tar' = runProgramM tarProgram
436+
437+
-- | Creates a tarball of a directory, such that if you
438+
-- archive the directory "/foo/bar/baz" to "mine.tgz", @tar tf@ reports
439+
-- @baz/file1@, @baz/file2@, etc.
440+
archiveTo :: FilePath -> FilePath -> TestM ()
441+
src `archiveTo` dst = do
442+
-- TODO: Consider using the @tar@ library?
443+
let (src_parent, src_dir) = splitFileName src
444+
-- TODO: --format ustar, like createArchive?
445+
tar ["-czf", dst, "-C", src_parent, src_dir]
446+
447+
infixr 4 `archiveTo`
448+
449+
-- | Given a directory (relative to the 'testCurrentDir') containing
450+
-- a series of directories representing packages, generate an
451+
-- external repository corresponding to all of these packages
452+
withRepo :: FilePath -> TestM a -> TestM a
453+
withRepo repo_dir m = do
454+
env <- getTestEnv
455+
-- 1. Generate keys
456+
hackageRepoTool "create-keys" ["--keys", testKeysDir env]
457+
-- 2. Initialize repo directory
458+
let package_dir = testRepoDir env </> "package"
459+
liftIO $ createDirectoryIfMissing True (testRepoDir env </> "index")
460+
liftIO $ createDirectoryIfMissing True package_dir
461+
-- 3. Create tarballs
462+
pkgs <- liftIO $ getDirectoryContents (testCurrentDir env </> repo_dir)
463+
forM_ pkgs $ \pkg -> do
464+
case pkg of
465+
'.':_ -> return ()
466+
_ -> testCurrentDir env </> repo_dir </> pkg
467+
`archiveTo`
468+
package_dir </> pkg <.> "tar.gz"
469+
-- 4. Initialize repository
470+
hackageRepoTool "bootstrap" ["--keys", testKeysDir env, "--repo", testRepoDir env]
471+
-- 5. Wire it up in .cabal/config
472+
-- TODO: libify this
473+
let package_cache = testHomeDir env </> ".cabal" </> "packages"
474+
liftIO $ appendFile (testUserCabalConfigFile env)
475+
$ unlines [ "repository test-local-repo"
476+
, " url: file:" ++ testRepoDir env
477+
, " secure: True"
478+
-- TODO: Hypothetically, we could stick in the
479+
-- correct key here
480+
, " root-keys: "
481+
, " key-threshold: 0"
482+
, "remote-repo-cache: " ++ package_cache ]
483+
-- 6. Create local directories (TODO: this is a bug #4136, once you
484+
-- fix that this can be removed)
485+
liftIO $ createDirectoryIfMissing True (package_cache </> "test-local-repo")
486+
-- 7. Update our local index
487+
cabal "update" []
488+
-- 8. Profit
489+
withReaderT (\env' -> env' { testHaveRepo = True }) m
490+
-- TODO: Arguably should undo everything when we're done...
491+
385492
------------------------------------------------------------------------
386493
-- * Subprocess run results
387494

0 commit comments

Comments
 (0)