@@ -226,6 +226,8 @@ cabal' cmd args = do
226
226
-- Sandboxes manage dist dir
227
227
| testHaveSandbox env
228
228
= [ ]
229
+ | cmd == " update"
230
+ = [ ]
229
231
-- new-build commands are affected by testCabalProjectFile
230
232
| " new-" `isPrefixOf` cmd
231
233
= [ " --builddir" , testDistDir env
@@ -382,6 +384,111 @@ runInstalledExe' exe_name args = do
382
384
shell :: String -> [String ] -> TestM Result
383
385
shell exe args = runM exe args
384
386
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
+
385
492
------------------------------------------------------------------------
386
493
-- * Subprocess run results
387
494
0 commit comments