Skip to content

Use a local secure repositories in the test-suite. #9540

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Use a local secure repositories in the test-suite. #9540

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
9bb3af3
Use a local secure repositories in the test-suite.
andreabedini Dec 19, 2023
7bedf81
Apply suggestions from code review
andreabedini Dec 20, 2023
d3502d2
try time-compat
ulysses4ever Dec 25, 2023
e9ea717
testsute: tar: don't pass --force-local on Windows
ulysses4ever Dec 25, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 17 additions & 0 deletions cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,17 @@
# cabal update
Downloading the latest package list from test-local-repo
Package list of test-local-repo has been updated.
The index-state is set to 2023-12-25T00:00:00Z.
# cabal build
Error: [Cabal-7159]
Latest known index-state for 'test-local-repo' (2023-12-25T00:00:00Z) is older than the requested index-state (4000-01-01T00:00:00Z).
Run 'cabal update' or set the index-state to a value at or before 2023-12-25T00:00:00Z.
# cabal build
Warning: There is no index-state for 'test-local-repo' exactly at the requested timestamp (2023-01-01T00:00:00Z). Also, there are no index-states before the one requested, so the repository 'test-local-repo' will be empty.
Resolving dependencies...
Error: [Cabal-7107]
Could not resolve dependencies:
[__0] trying: fake-pkg-1.0 (user goal)
[__1] unknown package: pkg (dependency of fake-pkg)
[__1] fail (backjumping, conflict set: fake-pkg, pkg)
After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: fake-pkg (2), pkg (1)
13 changes: 0 additions & 13 deletions cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.out.in
View file
Open in desktop

This file was deleted.

30 changes: 13 additions & 17 deletions cabal-testsuite/PackageTests/NewUpdate/RejectFutureIndexStates/cabal.test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,19 +1,15 @@
import Test.Cabal.Prelude
import Data.List (isPrefixOf)

main = cabalTest $ withProjectFile "cabal.project" $ withRemoteRepo "repo" $ do
output <- last
. words
. head
. filter ("Index cache updated to index-state " `isPrefixOf`)
. lines
. resultOutput
<$> recordMode DoNotRecord (cabal' "update" [])
-- update golden output with actual timestamp
shell "cp" ["cabal.out.in", "cabal.out"]
shell "sed" ["-i''", "-e", "s/REPLACEME/" <> output <> "/g", "cabal.out"]
-- This shall fail with an error message as specified in `cabal.out`
fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"]
-- This shall fail by not finding the package, what indicates that it
-- accepted an older index-state.
fails $ cabal "build" ["--index-state=2023-01-01T00:00:00Z", "fake-pkg"]
main =
cabalTest $
withProjectFile "cabal.project" $ do
-- This is the head index-state
iso8601ParseM "2023-12-25T00:00:00Z"
>>= setModificationTime "repo/pkg-1.0/pkg.cabal"
withSecureRepo "repo" $ do
cabal "update" []
-- This shall fail with an error message as specified in `cabal.out`
fails $ cabal "build" ["--index-state=4000-01-01T00:00:00Z", "fake-pkg"]
-- This shall fail by not finding the package, what indicates that it
-- accepted an older index-state.
fails $ cabal "build" ["--index-state=2023-01-01T00:00:00Z", "fake-pkg"]
20 changes: 11 additions & 9 deletions cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.out
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,14 @@
# 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'
Downloading the latest package list from test-local-repo
Package list of test-local-repo has been updated.
The index-state is set to 2023-01-01T00:00:00Z.
# 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.
Downloading the latest package list from test-local-repo
Package list of test-local-repo is up to date.
The index-state is set to 2022-01-01T00:00:00Z.
To revert to previous state run:
cabal v2-update 'repository.localhost,2016-09-24T17:47:48Z'
cabal v2-update 'test-local-repo,2023-01-01T00:00:00Z'
# cabal update
Downloading the latest package list from test-local-repo
Package list of test-local-repo is up to date.
The index-state is set to 2022-01-01T00:00:00Z.
23 changes: 13 additions & 10 deletions cabal-testsuite/PackageTests/NewUpdate/UpdateIndexState/update-index-state.test.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,12 +1,15 @@
import Test.Cabal.Prelude

main = cabalTest $ withRemoteRepo "repo" $ do
-- The _first_ update call causes a warning about missing mirrors, the warning
-- is platform-dependent and it's not part of the test expectations, so we
-- check the output manually.
res <- recordMode DoNotRecord $
cabal' "update" ["repository.localhost,2022-01-28T02:36:41Z"]
assertOutputContains "The index-state is set to 2022-01-28T02:36:41Z" res
assertOutputDoesNotContain "revert" res
cabal "update" ["repository.localhost,2016-09-24T17:47:48Z"]
cabal "update" ["repository.localhost,2022-01-28T02:36:41Z"]
main = cabalTest $ do
-- This is the head index-state
iso8601ParseM "2023-01-01T00:00:00Z"
>>= setModificationTime ("repo" </> "pkg-1.0/pkg.cabal")

withSecureRepo "repo" $ do
cabal "update" []

-- Check that we mention the previous timestamp
res <- cabal' "update" ["test-local-repo,2022-01-01T00:00:00Z"]
assertOutputContains "test-local-repo,2023-01-01T00:00:00Z" res

cabal "update" ["test-local-repo,2022-01-01T00:00:00Z"]
3 changes: 2 additions & 1 deletion cabal-testsuite/cabal-testsuite.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,6 @@ library
, directory ^>= 1.2.0.1 || ^>= 1.3.0.0
, exceptions ^>= 0.10.0
, filepath ^>= 1.3.0.1 || ^>= 1.4.0.0 || ^>= 1.5.0.0
, network-wait ^>= 0.1.2.0 || ^>= 0.2.0.0
, optparse-applicative ^>= 0.14.3.0 || ^>=0.15.1.0 || ^>=0.16.0.0 || ^>= 0.17.0.0 || ^>= 0.18.1.0
, process ^>= 1.2.1.0 || ^>= 1.4.2.0 || ^>= 1.6.1.0
, regex-base ^>= 0.94.0.1
Expand All @@ -77,6 +76,8 @@ library
, array ^>= 0.4.0.1 || ^>= 0.5.0.0
, temporary ^>= 1.3
, text ^>= 1.2.3.1 || ^>= 2.0.1 || ^>= 2.1
, time-compat ^>= 1.9.0.0
, time
, transformers ^>= 0.3.0.0 || ^>= 0.4.2.0 || ^>= 0.5.2.0 || ^>= 0.6.0.2

if !os(windows)
Expand Down
2 changes: 1 addition & 1 deletion cabal-testsuite/src/Test/Cabal/Monad.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -239,7 +239,7 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do
-- Add test suite specific programs
let program_db0 =
addKnownPrograms
([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram, python3Program] ++ builtinPrograms)
([gitProgram, hackageRepoToolProgram, cabalProgram, diffProgram] ++ builtinPrograms)
(runnerProgramDb senv)
-- Reconfigure according to user flags
let cargs = testCommonArgs args
Expand Down
150 changes: 69 additions & 81 deletions cabal-testsuite/src/Test/Cabal/Prelude.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,7 @@ module Test.Cabal.Prelude (
module Control.Monad.IO.Class,
module Distribution.Version,
module Distribution.Simple.Program,
module Data.Time.Format.ISO8601.Compat
) where

import Test.Cabal.Script
Expand All @@ -35,7 +36,8 @@ import Distribution.Simple.Configure
( getPersistBuildConfig )
import Distribution.Version
import Distribution.Package
import Distribution.Parsec (eitherParsec)
import Distribution.Parsec (eitherParsec, simpleParsec)
import Distribution.Pretty (prettyShow)
import Distribution.Types.UnqualComponentName
import Distribution.Types.LocalBuildInfo
import Distribution.PackageDescription
Expand All @@ -58,15 +60,15 @@ import qualified Data.ByteString.Char8 as C
import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate)
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Maybe (mapMaybe, fromMaybe)
import Data.Maybe (mapMaybe, fromMaybe, fromJust)
import System.Exit (ExitCode (..))
import System.FilePath
import Control.Concurrent (threadDelay)
import qualified Data.Char as Char
import System.Directory
import Control.Retry (exponentialBackoff, limitRetriesByCumulativeDelay)
import Network.Wait (waitTcpVerbose)
import System.Environment
import Data.Time
import Data.Time.Format.ISO8601.Compat (iso8601ParseM)
import System.Directory

#ifndef mingw32_HOST_OS
import Control.Monad.Catch ( bracket_ )
Expand Down Expand Up @@ -527,7 +529,6 @@ src `archiveTo` dst = do
-- TODO: --format ustar, like createArchive?
-- --force-local is necessary for handling colons in Windows paths.
tar $ ["-czf", dst]
++ ["--force-local" | buildOS == Windows]
++ ["-C", src_parent, src_dir]

infixr 4 `archiveTo`
Expand Down Expand Up @@ -589,83 +590,78 @@ withRepo repo_dir m = do
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
-- a series of directories representing packages, generate a
-- secure repository corresponding to all of these packages
withSecureRepo :: FilePath -> TestM a -> TestM a
withSecureRepo repo_dir m = do
env <- getTestEnv

-- 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
-- 1. Generate keys
hackageRepoTool "create-keys" ["--keys", testKeysDir env]
keyIds <- liftIO $ fmap (map takeBaseName) $ listDirectory (testKeysDir env </> "root")

env <- getTestEnv
-- 2. Create root and mirrors metadata
hackageRepoTool "create-root" ["--keys", testKeysDir env, "-o", testRepoDir env </> "root.json"]
hackageRepoTool "create-mirrors" ["--keys", testKeysDir env, "-o", testRepoDir env </> "mirrors.json"]

let workDir = testRepoDir env
-- 3. Create repo directories
let package_dir = testRepoDir env </> "package"
index_dir = testRepoDir env </> "index"
liftIO $ createDirectoryIfMissing True package_dir
liftIO $ createDirectoryIfMissing True index_dir

-- 1. Initialize repo and repo_keys directory
let keysDir = workDir </> "keys"
let packageDir = workDir </> "package"
-- 4. Create tarballs
pkgs <- liftIO $ listDirectory (testCurrentDir env </> repo_dir)
forM_ pkgs $ \pkg -> do
let srcPath = testCurrentDir env </> repo_dir </> pkg
let sdistPath = package_dir </> pkg <.> "tar.gz"

liftIO $ createDirectoryIfMissing True packageDir
liftIO $ createDirectoryIfMissing True keysDir
let PackageIdentifier{pkgName = pn, pkgVersion = pv} = fromJust (simpleParsec pkg)
idxPath = index_dir </> unPackageName pn </> prettyShow pv </> unPackageName pn <.> "cabal"

-- 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")
srcPath `archiveTo` sdistPath

-- When hackage-repo-tool extracts the cabal file from the tarball, it does carry
-- over the timestamp; so what ends up in the index is the time of this operation.
--
-- We extract the cabal file ourselves carrying over the modification time.
-- hackage-repo-tool would re-extract the cabal file if the sdist is newer, to
-- avoid this possibility, we apply the same modification time to the sdist.
liftIO $ do
createDirectoryIfMissing True (takeDirectory idxPath)
copyFileWithMetadata (srcPath </> unPackageName pn <.> "cabal") idxPath

-- 3. Create keys and bootstrap repository
hackageRepoTool "create-keys" $ ["--keys", keysDir ]
hackageRepoTool "bootstrap" $ ["--keys", keysDir, "--repo", workDir]
ts <- System.Directory.getModificationTime (srcPath </> unPackageName pn <.> "cabal")
System.Directory.setModificationTime sdistPath ts

-- 4. Wire it up in .cabal/config
-- 5. Update repository
hackageRepoTool "update" ["--keys", testKeysDir env, "--repo", testRepoDir env]

-- 6. Wire it up in .cabal/config
let package_cache = testCabalDir env </> "packages"
-- In the following we launch a python http server to serve the remote
-- repository. When the http server is ready we proceed with the tests.
-- NOTE 1: it's important that both the http server and cabal use the
-- same hostname ("localhost"), otherwise there could be a mismatch
-- (depending on the details of the host networking settings).
-- NOTE 2: here we use a fixed port (8000). This can cause problems in
-- case multiple tests are running concurrently or other another
-- process on the developer machine is using the same port.
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
(flip runReaderT env $ python3 ["-m", "http.server", "-d", workDir, "--bind", "localhost", "8000"])
(\_ -> 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 }))
liftIO $ appendFile (testUserCabalConfigFile env)
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

As an option, you could use cabal user-config update? But, perhaps, this doesn’t matter.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

uhm, TIL, how does that work? I have never used it before.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Not sure what's the right way to call cabal-install in this part of the code, but from the command line you can do something like this to experiment:

❯ CABAL_DIR=. cabal update
❯ CABAL_DIR=. cabal user-config update --augment="repository test-local-repo
    url: file:some/dir/file
    secure: True
    root-keys: mykeys"

and observe ./config. This seems to work for a repository, but trying to update remote-repo-cache doesn't do what is desired here: it updates the existing field from the default value ./packages to whatever new value you supply. Unless I misunderstand what appendFile achieves: if it overrides the earlier value of remote-repo-cache, then maybe it's the same.

I see now that it's not your code: you just moved around what was there before, so I want to clarify that my remark about user-config shouldn't derail the PR.

$ unlines [ "repository test-local-repo"
, " url: file:" ++ testRepoDir env
, " secure: True"
, " root-keys: " ++ unwords keyIds
, "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. Profit
withReaderT (\env' -> env' { testHaveRepo = True }) m

setModificationTime :: FilePath -> UTCTime -> TestM ()
setModificationTime fp ts = do
env <- getTestEnv
liftIO $ System.Directory.setModificationTime (testCurrentDir env </> fp) ts

getModificationTime :: FilePath -> TestM UTCTime
getModificationTime fp = do
env <- getTestEnv
liftIO $ System.Directory.getModificationTime (testCurrentDir env </> fp)

------------------------------------------------------------------------
-- * Subprocess run results
Expand Down Expand Up @@ -1021,14 +1017,6 @@ 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.
Expand Down