cabal-install 3.10.2.1 → 3.10.3.0
raw patch · 21 files changed
+253/−147 lines, 21 filesdep −base64-bytestringdep ~Cabaldep ~HTTPdep ~base
Dependencies removed: base64-bytestring
Dependency ranges changed: Cabal, HTTP, base, containers, filepath, tar, tasty
Files
- cabal-install.cabal +18/−11
- changelog +3/−0
- src/Distribution/Client/CmdExec.hs +32/−18
- src/Distribution/Client/CmdInstall.hs +8/−10
- src/Distribution/Client/CmdRun.hs +26/−3
- src/Distribution/Client/Compat/Tar.hs +68/−0
- src/Distribution/Client/Config.hs +8/−0
- src/Distribution/Client/Get.hs +8/−4
- src/Distribution/Client/HashValue.hs +3/−8
- src/Distribution/Client/HttpUtils.hs +3/−4
- src/Distribution/Client/ProjectConfig.hs +2/−3
- src/Distribution/Client/ProjectOrchestration.hs +1/−1
- src/Distribution/Client/ProjectPlanning.hs +10/−10
- src/Distribution/Client/ScriptUtils.hs +9/−8
- src/Distribution/Client/SetupWrapper.hs +7/−5
- src/Distribution/Client/Tar.hs +8/−28
- src/Distribution/Client/VCS.hs +8/−3
- src/Distribution/Client/Version.hs +5/−7
- tests/UnitTests/Distribution/Client/Get.hs +12/−12
- tests/UnitTests/Distribution/Client/Tar.hs +13/−11
- tests/UnitTests/Distribution/Client/VCS.hs +1/−1
cabal-install.cabal view
@@ -1,7 +1,7 @@ Cabal-Version: 2.2 Name: cabal-install-Version: 3.10.2.1+Version: 3.10.3.0 Synopsis: The command-line interface for Cabal and Hackage. Description: The \'cabal\' command-line program simplifies the process of managing@@ -17,8 +17,9 @@ Category: Distribution Build-type: Simple Extra-Source-Files:- README.md bash-completion/cabal+extra-doc-files:+ README.md changelog source-repository head@@ -42,7 +43,9 @@ ghc-options: -Wall -Wcompat -Wnoncanonical-monad-instances -Wincomplete-uni-patterns -Wincomplete-record-updates if impl(ghc < 8.8) ghc-options: -Wnoncanonical-monadfail-instances- if impl(ghc >=8.10)+ if impl(ghc >=9.0)+ -- Warning: even though introduced with GHC 8.10, -Wunused-packages+ -- gives false positives with GHC 8.10. ghc-options: -Wunused-packages common base-dep@@ -63,6 +66,10 @@ default-extensions: TypeOperators hs-source-dirs: src+ autogen-modules:+ Paths_cabal_install+ other-modules:+ Paths_cabal_install exposed-modules: -- this modules are moved from Cabal -- they are needed for as long until cabal-install moves to parsec parser@@ -101,6 +108,7 @@ Distribution.Client.Compat.Orphans Distribution.Client.Compat.Prelude Distribution.Client.Compat.Semaphore+ Distribution.Client.Compat.Tar Distribution.Client.Config Distribution.Client.Configure Distribution.Client.Dependency@@ -205,16 +213,15 @@ async >= 2.0 && < 2.3, array >= 0.4 && < 0.6, base16-bytestring >= 0.1.1 && < 1.1.0.0,- base64-bytestring >= 1.0 && < 1.3, binary >= 0.7.3 && < 0.9, bytestring >= 0.10.6.0 && < 0.13,- containers >= 0.5.6.2 && < 0.7,+ containers >= 0.5.6.2 && < 0.8, cryptohash-sha256 >= 0.11 && < 0.12, directory >= 1.3.7.0 && < 1.4, echo >= 0.1.3 && < 0.2, edit-distance >= 0.2.2 && < 0.3, exceptions >= 0.10.4 && < 0.11,- filepath >= 1.4.0.0 && < 1.5,+ filepath >= 1.4.0.0 && < 1.6, hashable >= 1.0 && < 1.5, HTTP >= 4000.1.5 && < 4000.5, mtl >= 2.0 && < 2.4,@@ -223,9 +230,9 @@ process >= 1.2.3.0 && < 1.7, random >= 1.2 && < 1.3, stm >= 2.0 && < 2.6,- tar >= 0.5.0.3 && < 0.6,+ tar >= 0.5.0.3 && < 0.7, time >= 1.5.0.1 && < 1.13,- zlib >= 0.5.3 && < 0.7,+ zlib >= 0.5.3 && < 0.8, hackage-security >= 0.6.2.0 && < 0.7, text >= 1.2.3 && < 1.3 || >= 2.0 && < 2.2, parsec >= 3.1.13.0 && < 3.2,@@ -360,7 +367,7 @@ build-depends: cabal-install, containers,- tasty >= 1.2.3 && <1.5,+ tasty >= 1.2.3 && <1.6, tasty-hunit >= 0.10 @@ -380,7 +387,7 @@ containers, directory, filepath,- tasty >= 1.2.3 && <1.5,+ tasty >= 1.2.3 && <1.6, tasty-hunit >= 0.10, tagged @@ -416,7 +423,7 @@ network-uri >= 2.6.2.0 && <2.7, random, tagged,- tasty >= 1.2.3 && <1.5,+ tasty >= 1.2.3 && <1.6, tasty-expected-failure, tasty-hunit >= 0.10, tasty-quickcheck,
changelog view
@@ -1,5 +1,8 @@ -*-change-log-*- +3.10.3.0 Hécate <hecate+github@glitchbra.in> January 2024+ * See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.3.0.md+ 3.10.2.1 Hécate <hecate+github@glitchbra.in> November 2023 * See https://github.com/haskell/cabal/blob/master/release-notes/cabal-install-3.10.2.1.md
src/Distribution/Client/CmdExec.hs view
@@ -27,6 +27,10 @@ ( ConfigFlags(configVerbosity) , GlobalFlags )+import Distribution.Client.ProjectConfig.Types+ ( ProjectConfig (projectConfigShared)+ , ProjectConfigShared (projectConfigProgPathExtra)+ ) import Distribution.Client.ProjectFlags ( removeIgnoreProjectOption )@@ -54,13 +58,13 @@ import Distribution.Simple.Command ( CommandUI(..) ) import Distribution.Simple.Program.Db- ( modifyProgramSearchPath+ ( appendProgramSearchPath+ , configuredPrograms , requireProgram , configuredPrograms ) import Distribution.Simple.Program.Find- ( ProgramSearchPathEntry(..)- )+ ( simpleProgram ) import Distribution.Simple.Program.Run ( programInvocation , runProgramInvocation@@ -69,7 +73,6 @@ ( programOverrideEnv , programDefaultArgs , programPath- , simpleProgram , ConfiguredProgram ) import Distribution.Simple.GHC@@ -80,12 +83,14 @@ ) import Distribution.Simple.Utils ( die'- , info , createDirectoryIfMissingVerbose , withTempDirectory , wrapText , notice )+import Distribution.Utils.NubList+ ( fromNubList+ ) import Distribution.Verbosity ( normal )@@ -147,13 +152,16 @@ mempty -- Some dependencies may have executables. Let's put those on the PATH.- extraPaths <- pathAdditions verbosity baseCtx buildCtx- let programDb = modifyProgramSearchPath- (map ProgramSearchPathDir extraPaths ++)- . pkgConfigCompilerProgs- . elaboratedShared- $ buildCtx+ let extraPaths = pathAdditions baseCtx buildCtx + programDb <-+ appendProgramSearchPath+ verbosity+ extraPaths+ . pkgConfigCompilerProgs+ . elaboratedShared+ $ buildCtx+ -- Now that we have the packages, set up the environment. We accomplish this -- by creating an environment file that selects the databases and packages we -- computed in the previous step, and setting an environment variable to@@ -235,15 +243,21 @@ buildStatus action envOverrides) -pathAdditions :: Verbosity -> ProjectBaseContext -> ProjectBuildContext -> IO [FilePath]-pathAdditions verbosity ProjectBaseContext{..}ProjectBuildContext{..} = do- info verbosity . unlines $ "Including the following directories in PATH:"- : paths- return paths+-- | Get paths to all dependency executables to be included in PATH.+pathAdditions :: ProjectBaseContext -> ProjectBuildContext -> [FilePath]+pathAdditions ProjectBaseContext{..} ProjectBuildContext{..} =+ paths ++ cabalConfigPaths where- paths = S.toList- $ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute+ cabalConfigPaths =+ fromNubList+ . projectConfigProgPathExtra+ . projectConfigShared+ $ projectConfig+ paths =+ S.toList $+ binDirectories distDirLayout elaboratedShared elaboratedPlanToExecute +-- | Get paths to all dependency executables to be included in PATH. binDirectories :: DistDirLayout -> ElaboratedSharedConfig
src/Distribution/Client/CmdInstall.hs view
@@ -59,11 +59,9 @@ , projectConfigConfigFile ) import Distribution.Simple.Program.Db ( userSpecifyPaths, userSpecifyArgss, defaultProgramDb- , modifyProgramSearchPath )+ , appendProgramSearchPath ) import Distribution.Simple.BuildPaths ( exeExtension )-import Distribution.Simple.Program.Find- ( ProgramSearchPathEntry(..) ) import Distribution.Client.Config ( defaultInstallPath, loadConfig, SavedConfig(..) ) import qualified Distribution.Simple.PackageIndex as PI@@ -324,7 +322,8 @@ projectConfigHcFlavor, projectConfigHcPath, projectConfigHcPkg,- projectConfigStoreDir+ projectConfigStoreDir,+ projectConfigProgPathExtra }, projectConfigLocalPackages = PackageConfig { packageConfigProgramPaths,@@ -337,14 +336,13 @@ hcPath = flagToMaybe projectConfigHcPath hcPkg = flagToMaybe projectConfigHcPkg + configProgDb <- appendProgramSearchPath verbosity ((fromNubList packageConfigProgramPathExtra) ++ (fromNubList projectConfigProgPathExtra)) defaultProgramDb+ let -- ProgramDb with directly user specified paths preProgDb =- userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))- . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs))- . modifyProgramSearchPath- (++ [ ProgramSearchPathDir dir- | dir <- fromNubList packageConfigProgramPathExtra ])- $ defaultProgramDb+ userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))+ . userSpecifyArgss (Map.toList (getMapMappend packageConfigProgramArgs))+ $ configProgDb -- progDb is a program database with compiler tools configured properly (compiler@Compiler { compilerId =
src/Distribution/Client/CmdRun.hs view
@@ -34,12 +34,14 @@ ( toList, foldPlanPackage ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )+import Distribution.Client.ProjectConfig.Types import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..)- , ElaboratedInstallPlan, binDirectoryFor )+ , ElaboratedInstallPlan, binDirectoryFor+ ) import Distribution.Client.ProjectPlanning.Types- ( dataDirsEnvironmentForPlan )+ ( dataDirsEnvironmentForPlan, elabExeDependencyPaths ) import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), TargetContext(..) , updateContextAndWriteProjectFile, withContextAndSelectors@@ -52,6 +54,10 @@ ( CommandUI(..), usageAlternatives ) import Distribution.Simple.Flag ( fromFlagOrDefault )+import Distribution.Simple.Program.Find+ ( ProgramSearchPathEntry(..), defaultProgramSearchPath,+ programSearchPathAsPATHVar, logExtraProgramSearchPath+ ) import Distribution.Simple.Program.Run ( runProgramInvocation, ProgramInvocation(..), emptyProgramInvocation )@@ -61,6 +67,8 @@ ( componentNameRaw ) import Distribution.Types.UnitId ( UnitId )+import Distribution.Utils.NubList+ ( fromNubList ) import Distribution.Types.UnqualComponentName ( UnqualComponentName, unUnqualComponentName )@@ -69,6 +77,7 @@ import Data.List (group) import qualified Data.Set as Set+ import System.Directory ( doesFileExist ) import System.FilePath@@ -230,6 +239,19 @@ let dryRun = buildSettingDryRun (buildSettings baseCtx) || buildSettingOnlyDownload (buildSettings baseCtx) + let extraPath =+ elabExeDependencyPaths pkg+ ++ ( fromNubList+ . projectConfigProgPathExtra+ . projectConfigShared+ . projectConfig+ $ baseCtx+ )++ logExtraProgramSearchPath verbosity extraPath++ progPath <- programSearchPathAsPATHVar (map ProgramSearchPathDir extraPath ++ defaultProgramSearchPath)+ if dryRun then notice verbosity "Running of executable suppressed by flag(s)" else@@ -238,7 +260,8 @@ emptyProgramInvocation { progInvokePath = exePath, progInvokeArgs = args,- progInvokeEnv = dataDirsEnvironmentForPlan+ progInvokeEnv = ("PATH", Just $ progPath)+ : dataDirsEnvironmentForPlan (distDirLayout baseCtx) elaboratedPlan }
+ src/Distribution/Client/Compat/Tar.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++{- FOURMOLU_DISABLE -}+module Distribution.Client.Compat.Tar+ ( extractTarGzFile+#if MIN_VERSION_tar(0,6,0)+ , Tar.Entry+ , Tar.Entries+ , Tar.GenEntries (..)+ , Tar.GenEntryContent (..)+ , Tar.entryContent+#else+ , Tar.Entries (..)+ , Tar.Entry (..)+ , Tar.EntryContent (..)+#endif+ ) where+{- FOURMOLU_ENABLE -}++import Distribution.Client.Compat.Prelude+import Prelude ()++import qualified Codec.Archive.Tar as Tar+import qualified Codec.Archive.Tar.Check as Tar+#if MIN_VERSION_tar(0,6,0)+#else+import qualified Codec.Archive.Tar.Entry as Tar+#endif+import qualified Data.ByteString.Lazy as BS+import qualified Distribution.Client.GZipUtils as GZipUtils++instance (Exception a, Exception b) => Exception (Either a b) where+ toException (Left e) = toException e+ toException (Right e) = toException e++ fromException e =+ case fromException e of+ Just e' -> Just (Left e')+ Nothing -> case fromException e of+ Just e' -> Just (Right e')+ Nothing -> Nothing++{- FOURMOLU_DISABLE -}+extractTarGzFile+ :: FilePath+ -- ^ Destination directory+ -> FilePath+ -- ^ Expected subdir (to check for tarbombs)+ -> FilePath+ -- ^ Tarball+ -> IO ()+extractTarGzFile dir expected tar =+#if MIN_VERSION_tar(0,6,0)+ Tar.unpackAndCheck+ ( \x ->+ SomeException <$> Tar.checkEntryTarbomb expected x+ <|> SomeException <$> Tar.checkEntrySecurity x+ )+ dir+#else+ Tar.unpack dir+ . Tar.checkTarbomb expected+#endif+ . Tar.read+ . GZipUtils.maybeDecompress+ =<< BS.readFile tar+{- FOURMOLU_ENABLE -}
src/Distribution/Client/Config.hs view
@@ -1280,6 +1280,14 @@ , configConfigureArgs = splitMultiPath (configConfigureArgs scf) }+ , savedGlobalFlags =+ let sgf = savedGlobalFlags conf+ in sgf {+ globalProgPathExtra =+ toNubList $+ splitMultiPath+ (fromNubList $ globalProgPathExtra sgf)+ } } parse = parseFields (configFieldDescriptions src
src/Distribution/Client/Get.hs view
@@ -37,6 +37,8 @@ ( programName ) import Distribution.Types.SourceRepo (RepoKind (..)) import Distribution.Client.Types.SourceRepo (SourceRepositoryPackage (..), SourceRepoProxy, srpToProxy)+import Distribution.Utils.NubList+ ( fromNubList ) import Distribution.Client.Setup ( GlobalFlags(..), GetFlags(..), RepoContext(..) )@@ -54,6 +56,7 @@ import qualified Data.Map as Map import Control.Monad ( mapM_ )+ import System.Directory ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist ) import System.FilePath@@ -70,7 +73,7 @@ get verbosity _ _ _ [] = notice verbosity "No packages requested. Nothing to do." -get verbosity repoCtxt _ getFlags userTargets = do+get verbosity repoCtxt globalFlags getFlags userTargets = do let useSourceRepo = case getSourceRepository getFlags of NoFlag -> False _ -> True@@ -121,7 +124,7 @@ prefix = fromFlagOrDefault "" (getDestDir getFlags) clone :: [UnresolvedSourcePackage] -> IO ()- clone = clonePackagesFromSourceRepo verbosity prefix kind+ clone = clonePackagesFromSourceRepo verbosity prefix kind (fromNubList $ globalProgPathExtra globalFlags) . map (\pkg -> (packageId pkg, packageSourceRepos pkg)) where kind :: Maybe RepoKind@@ -278,18 +281,19 @@ clonePackagesFromSourceRepo :: Verbosity -> FilePath -- ^ destination dir prefix -> Maybe RepoKind -- ^ preferred 'RepoKind'+ -> [FilePath] -- ^ Extra prog paths -> [(PackageId, [PD.SourceRepo])] -- ^ the packages and their -- available 'SourceRepo's -> IO () clonePackagesFromSourceRepo verbosity destDirPrefix- preferredRepoKind pkgrepos = do+ preferredRepoKind progPaths pkgrepos = do -- Do a bunch of checks and collect the required info pkgrepos' <- traverse preCloneChecks pkgrepos -- Configure the VCS drivers for all the repository types we may need- vcss <- configureVCSs verbosity $+ vcss <- configureVCSs verbosity progPaths $ Map.fromList [ (vcsRepoType vcs, vcs) | (_, _, vcs, _) <- pkgrepos' ]
src/Distribution/Client/HashValue.hs view
@@ -6,7 +6,6 @@ hashValue, truncateHash, showHashValue,- showHashValueBase64, readFileHashValue, hashFromTUF, ) where@@ -16,10 +15,9 @@ import qualified Hackage.Security.Client as Sec -import qualified Crypto.Hash.SHA256 as SHA256-import qualified Data.ByteString.Base16 as Base16-import qualified Data.ByteString.Base64 as Base64-import qualified Data.ByteString.Char8 as BS+import qualified Crypto.Hash.SHA256 as SHA256+import qualified Data.ByteString.Base16 as Base16+import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import System.IO (IOMode (..), withBinaryFile)@@ -56,9 +54,6 @@ showHashValue :: HashValue -> String showHashValue (HashValue digest) = BS.unpack (Base16.encode digest)--showHashValueBase64 :: HashValue -> String-showHashValueBase64 (HashValue digest) = BS.unpack (Base64.encode digest) -- | Hash the content of a file. Uses SHA256. --
src/Distribution/Client/HttpUtils.hs view
@@ -54,13 +54,12 @@ import Distribution.Simple.Program ( Program, simpleProgram, ConfiguredProgram, programPath , ProgramInvocation(..), programInvocation- , ProgramSearchPathEntry(..) , getProgramInvocationOutput ) import Distribution.Simple.Program.Db ( ProgramDb, emptyProgramDb, addKnownPrograms , configureAllKnownPrograms , requireProgram, lookupProgram- , modifyProgramSearchPath )+ , appendProgramSearchPath ) import Distribution.Simple.Program.Run ( getProgramInvocationOutputAndErrors ) import Numeric (showHex)@@ -336,7 +335,7 @@ case find (\(name',_,_,_) -> name' == name) supportedTransports of Just (_, mprog, _tls, mkTrans) -> do - let baseProgDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb+ baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb progdb <- case mprog of Nothing -> return emptyProgramDb Just prog -> snd <$> requireProgram verbosity prog baseProgDb@@ -356,7 +355,7 @@ -- for all the transports except plain-http we need to try and find -- their external executable- let baseProgDb = modifyProgramSearchPath (\p -> map ProgramSearchPathDir extraPath ++ p) emptyProgramDb+ baseProgDb <- appendProgramSearchPath verbosity extraPath emptyProgramDb progdb <- configureAllKnownPrograms verbosity $ addKnownPrograms [ prog | (_, Just prog, _, _) <- supportedTransports ]
src/Distribution/Client/ProjectConfig.hs view
@@ -1149,11 +1149,10 @@ [ ((rtype, rloc), [(repo, vcsRepoType vcs)]) | (repo, rloc, rtype, vcs) <- repos' ] - --TODO: pass progPathExtra on to 'configureVCS'- let _progPathExtra = fromNubList projectConfigProgPathExtra+ let progPathExtra = fromNubList projectConfigProgPathExtra getConfiguredVCS <- delayInitSharedResources $ \repoType -> let vcs = Map.findWithDefault (error $ "Unknown VCS: " ++ prettyShow repoType) repoType knownVCSs in- configureVCS verbosity {-progPathExtra-} vcs+ configureVCS verbosity progPathExtra vcs concat <$> sequenceA [ rerunIfChanged verbosity monitor repoGroup' $ do
src/Distribution/Client/ProjectOrchestration.hs view
@@ -190,7 +190,7 @@ deriving (Show, Eq) -- | This holds the context of a project prior to solving: the content of the--- @cabal.project@ and all the local package @.cabal@ files.+-- @cabal.project@, @cabal/config@ and all the local package @.cabal@ files. -- data ProjectBaseContext = ProjectBaseContext { distDirLayout :: DistDirLayout,
src/Distribution/Client/ProjectPlanning.hs view
@@ -426,10 +426,12 @@ packageConfigProgramPathExtra) $ do liftIO $ info verbosity "Compiler settings changed, reconfiguring..."- result@(_, _, progdb') <- liftIO $+ progdb <- liftIO $ appendProgramSearchPath verbosity (fromNubList packageConfigProgramPathExtra) defaultProgramDb+ let progdb' = userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths)) progdb+ result@(_, _, progdb'') <- liftIO $ Cabal.configCompilerEx hcFlavor hcPath hcPkg- progdb verbosity+ progdb' verbosity -- Note that we added the user-supplied program locations and args -- for /all/ programs, not just those for the compiler prog and@@ -437,21 +439,16 @@ -- the compiler will configure (and it does vary between compilers). -- We do know however that the compiler will only configure the -- programs it cares about, and those are the ones we monitor here.- monitorFiles (programsMonitorFiles progdb')+ monitorFiles (programsMonitorFiles progdb'') return result where hcFlavor = flagToMaybe projectConfigHcFlavor hcPath = flagToMaybe projectConfigHcPath hcPkg = flagToMaybe projectConfigHcPkg- progdb =- userSpecifyPaths (Map.toList (getMapLast packageConfigProgramPaths))- . modifyProgramSearchPath- ([ ProgramSearchPathDir dir- | dir <- fromNubList packageConfigProgramPathExtra ] ++)- $ defaultProgramDb + -- | Return an up-to-date elaborated install plan. -- -- Two variants of the install plan are returned: with and without packages@@ -3397,7 +3394,10 @@ useDistPref = builddir, useLoggingHandle = Nothing, -- this gets set later useWorkingDir = Just srcdir,- useExtraPathEnv = elabExeDependencyPaths elab,+ useExtraPathEnv = elabExeDependencyPaths elab ++ elabProgramPathExtra,+ -- note that the above adds the extra-prog-path directly following the elaborated+ -- dep paths, so that it overrides the normal path, but _not_ the elaborated extensions+ -- for build-tools-depends. useExtraEnvOverrides = dataDirsEnvironmentForPlan distdir plan, useWin32CleanHack = False, --TODO: [required eventually] forceExternalSetupMethod = isParallelBuild,
src/Distribution/Client/ScriptUtils.hs view
@@ -27,7 +27,7 @@ import Distribution.Client.DistDirLayout ( DistDirLayout(..), DistDirParams(..) ) import Distribution.Client.HashValue- ( hashValue, showHashValueBase64 )+ ( hashValue, showHashValue, truncateHash ) import Distribution.Client.HttpUtils ( HttpTransport, configureTransport ) import Distribution.Client.NixStyleOptions@@ -131,17 +131,18 @@ -- repl to deal with the fact that the repl is relative to the working directory and not -- the project root. --- | Get the hash of a script's absolute path)+-- | Get the hash of a script's absolute path. -- -- Two hashes will be the same as long as the absolute paths -- are the same. getScriptHash :: FilePath -> IO String-getScriptHash script- -- Base64 is shorter than Base16, which helps avoid long path issues on windows- -- but it can contain /'s which aren't valid in file paths so replace them with- -- %'s. 26 chars / 130 bits is enough to practically avoid collisions.- = map (\c -> if c == '/' then '%' else c) . take 26- . showHashValueBase64 . hashValue . fromString <$> canonicalizePath script+getScriptHash script =+ -- Truncation here tries to help with long path issues on Windows.+ showHashValue+ . truncateHash 26+ . hashValue+ . fromString+ <$> canonicalizePath script -- | Get the directory for caching a script build. --
src/Distribution/Client/SetupWrapper.hs view
@@ -29,6 +29,7 @@ import Distribution.CabalSpecVersion (cabalSpecMinimumLibraryVersion) import qualified Distribution.Make as Make import qualified Distribution.Simple as Simple+ import Distribution.Version ( Version, mkVersion, versionNumbers, VersionRange, anyVersion , intersectVersionRanges, orLaterVersion@@ -59,9 +60,10 @@ ( ProgramDb, emptyProgramDb , getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram , ghcjsProgram )+import Distribution.Simple.Program.Db+ ( appendProgramSearchPath ) import Distribution.Simple.Program.Find- ( programSearchPathAsPATHVar- , ProgramSearchPathEntry(ProgramSearchPathDir) )+ ( programSearchPathAsPATHVar ) import Distribution.Simple.Program.Run ( getEffectiveEnvironment ) import qualified Distribution.Simple.Program.Strip as Strip@@ -443,9 +445,9 @@ Nothing -> return () Just logHandle -> info verbosity $ "Redirecting build log to " ++ show logHandle - searchpath <- programSearchPathAsPATHVar- (map ProgramSearchPathDir (useExtraPathEnv options) ++- getProgramSearchPath (useProgramDb options))+ progDb <- appendProgramSearchPath verbosity (useExtraPathEnv options) (useProgramDb options)++ searchpath <- programSearchPathAsPATHVar $ getProgramSearchPath progDb env <- getEffectiveEnvironment $ [ ("PATH", Just searchpath) , ("HASKELL_DIST_DIR", Just (useDistPref options))
src/Distribution/Client/Tar.hs view
@@ -14,10 +14,11 @@ -- Reading, writing and manipulating \"@.tar@\" archive files. -- ------------------------------------------------------------------------------module Distribution.Client.Tar (- -- * @tar.gz@ operations++module Distribution.Client.Tar+ ( -- * @tar.gz@ operations createTarGzFile,- extractTarGzFile,+ TarComp.extractTarGzFile, -- * Other local utils buildTreeRefTypeCode,@@ -31,12 +32,11 @@ import Distribution.Client.Compat.Prelude import Prelude () -import qualified Data.ByteString.Lazy as BS-import qualified Codec.Archive.Tar as Tar+import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar-import qualified Codec.Archive.Tar.Check as Tar-import qualified Codec.Compression.GZip as GZip-import qualified Distribution.Client.GZipUtils as GZipUtils+import qualified Codec.Compression.GZip as GZip+import qualified Data.ByteString.Lazy as BS+import qualified Distribution.Client.Compat.Tar as TarComp -- for foldEntries... import Control.Exception (throw)@@ -51,26 +51,6 @@ -> IO () createTarGzFile tar base dir = BS.writeFile tar . GZip.compress . Tar.write =<< Tar.pack base [dir]--extractTarGzFile :: FilePath -- ^ Destination directory- -> FilePath -- ^ Expected subdir (to check for tarbombs)- -> FilePath -- ^ Tarball- -> IO ()-extractTarGzFile dir expected tar =- Tar.unpack dir . Tar.checkTarbomb expected . Tar.read- . GZipUtils.maybeDecompress =<< BS.readFile tar--instance (Exception a, Exception b) => Exception (Either a b) where- toException (Left e) = toException e- toException (Right e) = toException e-- fromException e =- case fromException e of- Just e' -> Just (Left e')- Nothing -> case fromException e of- Just e' -> Just (Right e')- Nothing -> Nothing- -- | Type code for the local build tree reference entry type. We don't use the -- symbolic link entry type because it allows only 100 ASCII characters for the
src/Distribution/Client/VCS.hs view
@@ -50,6 +50,8 @@ , simpleProgram, findProgramVersion , ProgramInvocation(..), programInvocation, runProgramInvocation, getProgramInvocationOutput , emptyProgramDb, requireProgram )+import Distribution.Simple.Program.Db+ ( appendProgramSearchPath ) import Distribution.Version ( mkVersion ) import qualified Distribution.PackageDescription as PD@@ -169,17 +171,20 @@ configureVCS :: Verbosity+ -> [FilePath] -- ^ Extra prog paths -> VCS Program -> IO (VCS ConfiguredProgram)-configureVCS verbosity vcs@VCS{vcsProgram = prog} =- asVcsConfigured <$> requireProgram verbosity prog emptyProgramDb+configureVCS verbosity progPaths vcs@VCS{vcsProgram = prog} = do+ progPath <- appendProgramSearchPath verbosity progPaths emptyProgramDb+ asVcsConfigured <$> requireProgram verbosity prog progPath where asVcsConfigured (prog', _) = vcs { vcsProgram = prog' } configureVCSs :: Verbosity+ -> [FilePath] -- ^ Extra prog paths -> Map RepoType (VCS Program) -> IO (Map RepoType (VCS ConfiguredProgram))-configureVCSs verbosity = traverse (configureVCS verbosity)+configureVCSs verbosity progPaths = traverse (configureVCS verbosity progPaths) -- ------------------------------------------------------------
src/Distribution/Client/Version.hs view
@@ -6,11 +6,9 @@ import Distribution.Version --- This value determines the `cabal-install --version` output.------ It is used in several places throughout the project, including anonymous build reports, client configuration,--- and project planning output. Historically, this was a @Paths_*@ module, however, this conflicted with--- program coverage information generated by HPC, and hence was moved to be a standalone value.---+import qualified Paths_cabal_install as PackageInfo++-- |+-- This value determines the output of `cabal-install --version`. cabalInstallVersion :: Version-cabalInstallVersion = mkVersion [3,10,2,1]+cabalInstallVersion = mkVersion' PackageInfo.version
tests/UnitTests/Distribution/Client/Get.hs view
@@ -62,7 +62,7 @@ testNoRepos :: Assertion testNoRepos = do e <- assertException $- clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageNoSourceRepos pkgidfoo where pkgrepos = [(pkgidfoo, [])]@@ -71,7 +71,7 @@ testNoReposOfKind :: Assertion testNoReposOfKind = do e <- assertException $- clonePackagesFromSourceRepo verbosity "." repokind pkgrepos+ clonePackagesFromSourceRepo verbosity "." repokind [] pkgrepos e @?= ClonePackageNoSourceReposOfKind pkgidfoo repokind where pkgrepos = [(pkgidfoo, [repo])]@@ -82,7 +82,7 @@ testNoRepoType :: Assertion testNoRepoType = do e <- assertException $- clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity "." Nothing []pkgrepos e @?= ClonePackageNoRepoType pkgidfoo repo where pkgrepos = [(pkgidfoo, [repo])]@@ -92,7 +92,7 @@ testUnsupportedRepoType :: Assertion testUnsupportedRepoType = do e <- assertException $- clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageUnsupportedRepoType pkgidfoo repo' repotype where pkgrepos = [(pkgidfoo, [repo])]@@ -114,7 +114,7 @@ testNoRepoLocation :: Assertion testNoRepoLocation = do e <- assertException $- clonePackagesFromSourceRepo verbosity "." Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity "." Nothing [] pkgrepos e @?= ClonePackageNoRepoLocation pkgidfoo repo where pkgrepos = [(pkgidfoo, [repo])]@@ -133,7 +133,7 @@ e' <- test requestedRepoType (reverse pkgrepos) e' @?= ClonePackageNoRepoType pkgidfoo expectedRepo | let test rt rs = assertException $- clonePackagesFromSourceRepo verbosity "." rt rs+ clonePackagesFromSourceRepo verbosity "." rt [] rs , (requestedRepoType, expectedRepo) <- cases ] where@@ -154,14 +154,14 @@ let pkgdir = tmpdir </> "foo" createDirectory pkgdir e1 <- assertException $- clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e1 @?= ClonePackageDestinationExists pkgidfoo pkgdir True {- isdir -} removeDirectory pkgdir writeFile pkgdir "" e2 <- assertException $- clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e2 @?= ClonePackageDestinationExists pkgidfoo pkgdir False {- isfile -} where pkgrepos = [(pkgidfoo, [repo])]@@ -189,7 +189,7 @@ } pkgrepos = [(pkgidfoo, [repo])] e1 <- assertException $- clonePackagesFromSourceRepo verbosity tmpdir Nothing pkgrepos+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] pkgrepos e1 @?= ClonePackageFailedWithExitCode pkgidfoo repo' "git" (ExitFailure 128) @@ -200,7 +200,7 @@ repoType = Just (KnownRepoType Git), repoLocation = Just "https://github.com/haskell/zlib.git" }- clonePackagesFromSourceRepo verbosity tmpdir Nothing+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib1", [repo1])] assertFileContains (tmpdir </> "zlib1/zlib.cabal") ["name:", "zlib"] @@ -208,7 +208,7 @@ repoType = Just (KnownRepoType Git), repoLocation = Just (tmpdir </> "zlib1") }- clonePackagesFromSourceRepo verbosity tmpdir Nothing+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib2", [repo2])] assertFileContains (tmpdir </> "zlib2/zlib.cabal") ["name:", "zlib"] @@ -217,7 +217,7 @@ repoLocation = Just (tmpdir </> "zlib1"), repoTag = Just "0.5.0.0" }- clonePackagesFromSourceRepo verbosity tmpdir Nothing+ clonePackagesFromSourceRepo verbosity tmpdir Nothing [] [(mkpkgid "zlib3", [repo3])] assertFileContains (tmpdir </> "zlib3/zlib.cabal") ["version:", "0.5.0.0"] where
tests/UnitTests/Distribution/Client/Tar.hs view
@@ -2,17 +2,17 @@ tests ) where -import Distribution.Client.Tar ( filterEntries- , filterEntriesM- )-import Codec.Archive.Tar ( Entries(..)- , foldEntries- )-import Codec.Archive.Tar.Entry ( EntryContent(..)- , simpleEntry- , Entry(..)- , toTarPath- )+import Codec.Archive.Tar+ ( foldEntries+ )+import Codec.Archive.Tar.Entry+ ( simpleEntry+ , toTarPath+ )+import Distribution.Client.Tar+ ( filterEntries+ , filterEntriesM+ ) import Test.Tasty import Test.Tasty.HUnit@@ -20,6 +20,8 @@ import qualified Data.ByteString.Lazy as BS import qualified Data.ByteString.Lazy.Char8 as BS.Char8 import Control.Monad.Writer.Lazy (runWriterT, tell)++import Distribution.Client.Compat.Tar tests :: [TestTree] tests = [ testCase "filterEntries" filterTest
tests/UnitTests/Distribution/Client/VCS.hs view
@@ -179,7 +179,7 @@ -> IO a testSetup vcs mkVCSTestDriver repoRecipe theTest = do -- test setup- vcs' <- configureVCS verbosity vcs+ vcs' <- configureVCS verbosity [] vcs withTestDir verbosity "vcstest" $ \tmpdir -> do let srcRepoPath = tmpdir </> "src" submodulesPath = tmpdir </> "submodules"