From 6a6ba551f3b284ddd2b0a0cf09b2ea3117ad6167 Mon Sep 17 00:00:00 2001 From: Mel Zuser Date: Wed, 24 May 2023 16:44:58 +0000 Subject: [PATCH] Shorten script-builds paths (#8898) * Use shorter hash for script-builds directories Using a Base64 hash and truncating it to 26 characters, saves 38 chars, which helps avoid long paths issues on Windows, while still providing 130 bits of hash in order to avoid collisions. Bug #8841 * Use the script cache dir as the dist dir Putting script build products under dist-newstyle within the cache directory is unnecessary because we already control the cache directory and can ensure there are no conflicts. * Use the actual script name in the executable name Previously, the script name was sanitized in final executable name, because the executable name had to match the component name, which only allowed for a limited character set. Now we can use the actual script name in the executable name. This only lets us shorten the component name without losing clarity. * Add changelog entry * Reenable script tests for Windows/ghc-9.4.* (cherry picked from commit a482a63c193b0c86667ed61d9216c929cabf6cff) # Conflicts: # cabal-install/src/Distribution/Client/CmdRun.hs # cabal-install/src/Distribution/Client/ProjectConfig.hs --- .../Distribution/PackageDescription/Check.hs | 6 +- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdListBin.hs | 8 +- .../src/Distribution/Client/CmdRun.hs | 64 +++++++--- .../src/Distribution/Client/HashValue.hs | 5 + .../src/Distribution/Client/ProjectConfig.hs | 22 ++++ .../src/Distribution/Client/ScriptUtils.hs | 119 +++++++++++++----- .../PackageTests/ListBin/Script/cabal.out | 4 +- .../NewBuild/CmdBuild/Script/cabal.out | 6 +- .../CmdBuild/ScriptBuildRepl/cabal.out | 8 +- .../CmdBuild/ScriptBuildRepl/cabal.test.hs | 3 - .../CmdBuild/ScriptBuildRun/cabal.out | 8 +- .../CmdBuild/ScriptBuildRun/cabal.test.hs | 3 - .../NewBuild/CmdBuild/ScriptRerun/cabal.out | 6 +- .../NewBuild/CmdClean/Keep/cabal.out | 12 +- .../NewBuild/CmdClean/Orphan/cabal.out | 12 +- .../NewBuild/CmdClean/Script/cabal.out | 6 +- .../NewBuild/CmdRepl/Script/cabal.out | 4 +- .../NewBuild/CmdRepl/ScriptRerun/cabal.out | 6 +- .../NewBuild/CmdRun/Script/cabal.out | 6 +- .../NewBuild/CmdRun/ScriptLiterate/cabal.out | 6 +- .../CmdRun/ScriptLiterate/cabal.test.hs | 3 - .../CmdRun/ScriptNoExtension/cabal.out | 6 +- .../NewBuild/CmdRun/ScriptRerun/cabal.out | 6 +- .../CmdRun/ScriptWithProjectBlock/cabal.out | 6 +- cabal-testsuite/cabal-testsuite.cabal | 2 +- cabal-testsuite/src/Test/Cabal/Prelude.hs | 5 +- changelog.d/issue-8841 | 15 +++ 28 files changed, 247 insertions(+), 111 deletions(-) create mode 100644 changelog.d/issue-8841 diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 5d11072b354..93f465e5074 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -1385,7 +1385,7 @@ checkGhcOptions fieldName getOptions pkg = , checkFlags ["-prof"] $ PackageBuildWarning (OptProf fieldName) - , checkFlags ["-o"] $ + , unlessScript . checkFlags ["-o"] $ PackageBuildWarning (OptO fieldName) , checkFlags ["-hide-package"] $ @@ -1478,6 +1478,10 @@ checkGhcOptions fieldName getOptions pkg = checkFlags :: [String] -> PackageCheck -> Maybe PackageCheck checkFlags flags = check (any (`elem` flags) all_ghc_options) + unlessScript :: Maybe PackageCheck -> Maybe PackageCheck + unlessScript pc | packageId pkg == fakePackageId = Nothing + | otherwise = pc + checkTestAndBenchmarkFlags :: [String] -> PackageCheck -> Maybe PackageCheck checkTestAndBenchmarkFlags flags = check (any (`elem` flags) test_and_benchmark_ghc_options) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index fed9aad89cd..472a6e867d8 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -204,6 +204,7 @@ library 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.12, containers >= 0.5.6.2 && < 0.7, diff --git a/cabal-install/src/Distribution/Client/CmdListBin.hs b/cabal-install/src/Distribution/Client/CmdListBin.hs index 27674300849..8993e18e2de 100644 --- a/cabal-install/src/Distribution/Client/CmdListBin.hs +++ b/cabal-install/src/Distribution/Client/CmdListBin.hs @@ -28,7 +28,9 @@ import Distribution.Client.NixStyleOptions import Distribution.Client.ProjectOrchestration import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ScriptUtils - (AcceptNoTargets(..), TargetContext(..), updateContextAndWriteProjectFile, withContextAndSelectors) + ( AcceptNoTargets(..), TargetContext(..) + , updateContextAndWriteProjectFile, withContextAndSelectors + , movedExePath ) import Distribution.Client.Setup (GlobalFlags (..)) import Distribution.Client.TargetProblem (TargetProblem (..)) import Distribution.Simple.BuildPaths (dllExtension, exeExtension) @@ -170,7 +172,7 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do bin_file c = case c of CD.ComponentExe s - | s == selectedComponent -> [bin_file' s] + | s == selectedComponent -> [moved_bin_file s] CD.ComponentTest s | s == selectedComponent -> [bin_file' s] CD.ComponentBench s @@ -194,6 +196,8 @@ listbinAction flags@NixStyleFlags{..} args globalFlags = do then dist_dir "build" prettyShow s ("lib" ++ prettyShow s) <.> dllExtension plat else InstallDirs.bindir (elabInstallDirs elab) ("lib" ++ prettyShow s) <.> dllExtension plat + moved_bin_file s = fromMaybe (bin_file' s) (movedExePath selectedComponent distDirLayout elaboratedSharedConfig elab) + ------------------------------------------------------------------------------- -- Target Problem: the very similar to CmdRun ------------------------------------------------------------------------------- diff --git a/cabal-install/src/Distribution/Client/CmdRun.hs b/cabal-install/src/Distribution/Client/CmdRun.hs index 64241fd8bbc..5d60decceb0 100644 --- a/cabal-install/src/Distribution/Client/CmdRun.hs +++ b/cabal-install/src/Distribution/Client/CmdRun.hs @@ -22,22 +22,15 @@ module Distribution.Client.CmdRun ( import Prelude () import Distribution.Client.Compat.Prelude hiding (toList) -import Distribution.Client.ProjectOrchestration import Distribution.Client.CmdErrorMessages ( renderTargetSelector, showTargetSelector, renderTargetProblem, renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs, targetSelectorFilter, renderListCommaAnd, renderListPretty ) -import Distribution.Client.TargetProblem - ( TargetProblem (..) ) - -import Distribution.Client.NixStyleOptions - ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) -import Distribution.Client.Setup - ( GlobalFlags(..), ConfigFlags(..) ) import Distribution.Client.GlobalFlags ( defaultGlobalFlags ) +<<<<<<< HEAD import Distribution.Simple.Flag ( fromFlagOrDefault ) import Distribution.Simple.Command @@ -48,25 +41,58 @@ import Distribution.Verbosity ( normal, silent ) import Distribution.Simple.Utils ( wrapText, die', info, notice, safeHead ) +======= +import Distribution.Client.InstallPlan + ( toList, foldPlanPackage ) +import Distribution.Client.NixStyleOptions + ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags ) +import Distribution.Client.ProjectOrchestration +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import Distribution.Client.ProjectPlanning ( ElaboratedConfiguredPackage(..) , ElaboratedInstallPlan, binDirectoryFor ) import Distribution.Client.ProjectPlanning.Types ( dataDirsEnvironmentForPlan ) -import Distribution.Client.InstallPlan - ( toList, foldPlanPackage ) -import Distribution.Types.UnqualComponentName - ( UnqualComponentName, unUnqualComponentName ) +import Distribution.Client.ScriptUtils + ( AcceptNoTargets(..), TargetContext(..) + , updateContextAndWriteProjectFile, withContextAndSelectors + , movedExePath ) +import Distribution.Client.Setup + ( GlobalFlags(..), ConfigFlags(..) ) +import Distribution.Client.TargetProblem + ( TargetProblem (..) ) +import Distribution.Client.Utils + ( occursOnlyOrBefore, giveRTSWarning ) +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Simple.Flag + ( fromFlagOrDefault ) import Distribution.Simple.Program.Run ( runProgramInvocation, ProgramInvocation(..), emptyProgramInvocation ) +import Distribution.Simple.Utils + ( wrapText, die', info, notice, safeHead, warn ) +import Distribution.Types.ComponentName + ( componentNameRaw ) import Distribution.Types.UnitId ( UnitId ) +<<<<<<< HEAD import Distribution.Client.ScriptUtils ( AcceptNoTargets(..), withContextAndSelectors, updateContextAndWriteProjectFile, TargetContext(..) ) +======= +import Distribution.Types.UnqualComponentName + ( UnqualComponentName, unUnqualComponentName ) +import Distribution.Verbosity + ( normal, silent ) +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import Data.List (group) import qualified Data.Set as Set +<<<<<<< HEAD +======= +import GHC.Environment + ( getFullArgs ) +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) import System.Directory ( doesFileExist ) import System.FilePath @@ -216,11 +242,15 @@ runAction flags@NixStyleFlags {..} targetAndArgs globalFlags ++ exeName ++ ":\n" ++ unlines (fmap (\p -> " - in package " ++ prettyShow (elabUnitId p)) elabPkgs) - let exePath = binDirectoryFor (distDirLayout baseCtx) - (elaboratedShared buildCtx) - pkg - exeName - exeName + + let defaultExePath = binDirectoryFor + (distDirLayout baseCtx) + (elaboratedShared buildCtx) + pkg + exeName + exeName + exePath = fromMaybe defaultExePath (movedExePath selectedComponent (distDirLayout baseCtx) (elaboratedShared buildCtx) pkg) + let dryRun = buildSettingDryRun (buildSettings baseCtx) || buildSettingOnlyDownload (buildSettings baseCtx) diff --git a/cabal-install/src/Distribution/Client/HashValue.hs b/cabal-install/src/Distribution/Client/HashValue.hs index 67117b231cc..86281a309ff 100644 --- a/cabal-install/src/Distribution/Client/HashValue.hs +++ b/cabal-install/src/Distribution/Client/HashValue.hs @@ -6,6 +6,7 @@ module Distribution.Client.HashValue ( hashValue, truncateHash, showHashValue, + showHashValueBase64, readFileHashValue, hashFromTUF, ) where @@ -17,6 +18,7 @@ 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 Data.ByteString.Lazy.Char8 as LBS @@ -55,6 +57,9 @@ hashValue = HashValue . SHA256.hashlazy 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. -- readFileHashValue :: FilePath -> IO HashValue diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 83184d5902c..e4412c5a7a1 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -31,6 +31,7 @@ module Distribution.Client.ProjectConfig ( readProjectLocalFreezeConfig, reportParseResult, showProjectConfig, + withGlobalConfig, withProjectOrGlobalConfig, writeProjectLocalExtraConfig, writeProjectLocalFreezeConfig, @@ -462,6 +463,27 @@ renderBadProjectRoot :: BadProjectRoot -> String renderBadProjectRoot (BadProjectRootExplicitFile projectFile) = "The given project file '" ++ projectFile ++ "' does not exist." +<<<<<<< HEAD +======= + BadProjectRootDir dir -> + "The given project directory '" <> dir <> "' does not exist." + + BadProjectRootAbsoluteFile file -> + "The given project file '" <> file <> "' does not exist." + + BadProjectRootDirFile dir file -> + "The given project directory/file combination '" <> dir file <> "' does not exist." + +withGlobalConfig + :: Verbosity -- ^ verbosity + -> Flag FilePath -- ^ @--cabal-config@ + -> (ProjectConfig -> IO a) -- ^ with global + -> IO a +withGlobalConfig verbosity gcf with = do + globalConfig <- runRebuild "" $ readGlobalConfig verbosity gcf + with globalConfig + +>>>>>>> a482a63c1 (Shorten script-builds paths (#8898)) withProjectOrGlobalConfig :: Verbosity -- ^ verbosity -> Flag Bool -- ^ whether to ignore local project (--ignore-project flag) diff --git a/cabal-install/src/Distribution/Client/ScriptUtils.hs b/cabal-install/src/Distribution/Client/ScriptUtils.hs index db377c8f10a..ce64c8a5ef6 100644 --- a/cabal-install/src/Distribution/Client/ScriptUtils.hs +++ b/cabal-install/src/Distribution/Client/ScriptUtils.hs @@ -9,7 +9,8 @@ module Distribution.Client.ScriptUtils ( getScriptHash, getScriptCacheDirectory, ensureScriptCacheDirectory, withContextAndSelectors, AcceptNoTargets(..), TargetContext(..), updateContextAndWriteProjectFile, updateContextAndWriteProjectFile', - fakeProjectSourcePackage, lSrcpkgDescription + fakeProjectSourcePackage, lSrcpkgDescription, + movedExePath ) where import Prelude () @@ -24,22 +25,24 @@ import Distribution.Client.ProjectOrchestration import Distribution.Client.Config ( defaultScriptBuildsDir ) import Distribution.Client.DistDirLayout - ( DistDirLayout(..) ) + ( DistDirLayout(..), DistDirParams(..) ) import Distribution.Client.HashValue - ( hashValue, showHashValue ) + ( hashValue, showHashValueBase64 ) import Distribution.Client.HttpUtils ( HttpTransport, configureTransport ) import Distribution.Client.NixStyleOptions ( NixStyleFlags (..) ) import Distribution.Client.ProjectConfig - ( ProjectConfig(..), ProjectConfigShared(..) - , reportParseResult, withProjectOrGlobalConfig + ( ProjectConfig(..), ProjectConfigShared(..), PackageConfig(..) + , reportParseResult, withGlobalConfig, withProjectOrGlobalConfig , projectConfigHttpTransport ) import Distribution.Client.ProjectConfig.Legacy ( ProjectConfigSkeleton , parseProjectSkeleton, instantiateProjectConfigSkeletonFetchingCompiler ) import Distribution.Client.ProjectFlags ( flagIgnoreProject ) +import Distribution.Client.ProjectPlanning + ( ElaboratedSharedConfig(..), ElaboratedConfiguredPackage(..) ) import Distribution.Client.RebuildMonad ( runRebuild ) import Distribution.Client.Setup @@ -48,6 +51,8 @@ import Distribution.Client.TargetSelector ( TargetSelectorProblem(..), TargetString(..) ) import Distribution.Client.Types ( PackageLocation(..), PackageSpecifier(..), UnresolvedSourcePackage ) +import Distribution.Compiler + ( CompilerId(..), perCompilerFlavorToList ) import Distribution.FieldGrammar ( parseFieldGrammar, takeFields ) import Distribution.Fields @@ -67,7 +72,7 @@ import Distribution.Simple.PackageDescription import Distribution.Simple.Setup ( Flag(..) ) import Distribution.Simple.Compiler - ( compilerInfo ) + ( Compiler(..), OptimisationLevel(..), compilerInfo ) import Distribution.Simple.Utils ( createDirectoryIfMissingVerbose, createTempDirectory, die', handleDoesNotExist, readUTF8File, warn, writeUTF8File ) import qualified Distribution.SPDX.License as SPDX @@ -77,6 +82,8 @@ import Distribution.System ( Platform(..) ) import Distribution.Types.BuildInfo ( BuildInfo(..) ) +import Distribution.Types.ComponentId + ( mkComponentId ) import Distribution.Types.CondTree ( CondTree(..) ) import Distribution.Types.Executable @@ -87,6 +94,10 @@ import Distribution.Types.PackageDescription ( PackageDescription(..), emptyPackageDescription ) import Distribution.Types.PackageName.Magic ( fakePackageCabalFileName, fakePackageId ) +import Distribution.Types.UnitId + ( newSimpleUnitId ) +import Distribution.Types.UnqualComponentName + ( UnqualComponentName ) import Distribution.Utils.NubList ( fromNubList ) import Distribution.Client.ProjectPlanning @@ -106,7 +117,7 @@ import qualified Data.Set as S import System.Directory ( canonicalizePath, doesFileExist, getTemporaryDirectory, removeDirectoryRecursive ) import System.FilePath - ( (), takeFileName ) + ( (), makeRelative, takeDirectory, takeFileName ) import qualified Text.Parsec as P -- A note on multi-module script support #6787: @@ -125,7 +136,12 @@ import qualified Text.Parsec as P -- Two hashes will be the same as long as the absolute paths -- are the same. getScriptHash :: FilePath -> IO String -getScriptHash script = showHashValue . hashValue . fromString <$> canonicalizePath script +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 -- | Get the directory for caching a script build. -- @@ -177,7 +193,7 @@ withContextAndSelectors -> IO b withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings globalFlags cmd act = withTemporaryTempDirectory $ \mkTmpDir -> do - (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag with (without mkTmpDir) + (tc, ctx) <- withProjectOrGlobalConfig verbosity ignoreProject globalConfigFlag withProject (withoutProject mkTmpDir) (tc', ctx', sels) <- case targetStrings of -- Only script targets may contain spaces and or end with ':'. @@ -209,19 +225,25 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig) defaultTarget = [TargetPackage TargetExplicitNamed [fakePackageId] Nothing] - with = do + withProject = do ctx <- establishProjectBaseContext verbosity cliConfig cmd return (ProjectContext, ctx) - without mkDir globalConfig = do - distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkDir + withoutProject mkTmpDir globalConfig = do + distDirLayout <- establishDummyDistDirLayout verbosity (globalConfig <> cliConfig) =<< mkTmpDir ctx <- establishDummyProjectBaseContext verbosity (globalConfig <> cliConfig) distDirLayout [] cmd return (GlobalContext, ctx) + + scriptBaseCtx script globalConfig = do + let noDistDir = mempty { projectConfigShared = mempty { projectConfigDistDir = Flag "" } } + let cfg = noDistDir <> globalConfig <> cliConfig + rootDir <- ensureScriptCacheDirectory verbosity script + distDirLayout <- establishDummyDistDirLayout verbosity cfg rootDir + establishDummyProjectBaseContext verbosity cfg distDirLayout [] cmd + scriptOrError script err = do exists <- doesFileExist script if exists then do - -- In the script case we always want a dummy context even when ignoreProject is False - let mkCacheDir = ensureScriptCacheDirectory verbosity script - (_, ctx) <- withProjectOrGlobalConfig verbosity (Flag True) globalConfigFlag with (without mkCacheDir) + ctx <- withGlobalConfig verbosity globalConfigFlag (scriptBaseCtx script) let projectRoot = distProjectRootDirectory $ distDirLayout ctx writeFile (projectRoot "scriptlocation") =<< canonicalizePath script @@ -236,14 +258,22 @@ withContextAndSelectors noTargets kind flags@NixStyleFlags {..} targetStrings gl projectCfgSkeleton <- readProjectBlockFromScript verbosity httpTransport (distDirLayout ctx) (takeFileName script) scriptContents - let fetchCompiler = do - (compiler, Platform arch os, _) <- runRebuild (distProjectRootDirectory . distDirLayout $ ctx) $ configureCompiler verbosity (distDirLayout ctx) ((fst $ ignoreConditions projectCfgSkeleton) <> projectConfig ctx) - pure (os, arch, compilerInfo compiler) + createDirectoryIfMissingVerbose verbosity True (distProjectCacheDirectory $ distDirLayout ctx) + (compiler, platform@(Platform arch os), _) <- runRebuild projectRoot $ configureCompiler verbosity (distDirLayout ctx) (fst (ignoreConditions projectCfgSkeleton) <> projectConfig ctx) + + projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler (pure (os, arch, compilerInfo compiler)) mempty projectCfgSkeleton + + let ctx' = ctx & lProjectConfig %~ (<> projectCfg) - projectCfg <- instantiateProjectConfigSkeletonFetchingCompiler fetchCompiler mempty projectCfgSkeleton + build_dir = distBuildDirectory (distDirLayout ctx') $ (scriptDistDirParams script) ctx' compiler platform + exePath = build_dir "bin" scriptExeFileName script + exePathRel = makeRelative projectRoot exePath + + executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just + & L.buildInfo . L.options %~ fmap (setExePath exePathRel) + + createDirectoryIfMissingVerbose verbosity True (takeDirectory exePath) - let executable' = executable & L.buildInfo . L.defaultLanguage %~ maybe (Just Haskell2010) Just - ctx' = ctx & lProjectConfig %~ (<> projectCfg) return (ScriptContext script executable', ctx', defaultTarget) else reportTargetSelectorProblems verbosity err @@ -260,6 +290,36 @@ withTemporaryTempDirectory act = newEmptyMVar >>= \m -> bracket (getMkTmp m) (rm return tmpDir rmTmp m _ = tryTakeMVar m >>= maybe (return ()) (handleDoesNotExist () . removeDirectoryRecursive) +scriptComponenetName :: IsString s => FilePath -> s +scriptComponenetName scriptPath = fromString cname + where + cname = "script-" ++ map censor (takeFileName scriptPath) + censor c | c `S.member` ccNamecore = c + | otherwise = '_' + +scriptExeFileName :: FilePath -> FilePath +scriptExeFileName scriptPath = "cabal-script-" ++ takeFileName scriptPath + +scriptDistDirParams :: FilePath -> ProjectBaseContext -> Compiler -> Platform -> DistDirParams +scriptDistDirParams scriptPath ctx compiler platform = DistDirParams + { distParamUnitId = newSimpleUnitId cid + , distParamPackageId = fakePackageId + , distParamComponentId = cid + , distParamComponentName = Just $ CExeName cn + , distParamCompilerId = compilerId compiler + , distParamPlatform = platform + , distParamOptimization = fromFlagOrDefault NormalOptimisation optimization + } + where + cn = scriptComponenetName scriptPath + cid = mkComponentId $ prettyShow fakePackageId <> "-inplace-" <> prettyShow cn + optimization = (packageConfigOptimization . projectConfigLocalPackages . projectConfig) ctx + +setExePath :: FilePath -> [String] -> [String] +setExePath exePath options + | "-o" `notElem` options = "-o" : exePath : options + | otherwise = options + -- | Add the 'SourcePackage' to the context and use it to write a .cabal file. updateContextAndWriteProjectFile' :: ProjectBaseContext -> SourcePackage (PackageLocation (Maybe FilePath)) -> IO ProjectBaseContext updateContextAndWriteProjectFile' ctx srcPkg = do @@ -284,15 +344,9 @@ updateContextAndWriteProjectFile ctx scriptPath scriptExecutable = do absScript <- canonicalizePath scriptPath let - -- Replace characters which aren't allowed in the executable component name with '_' - -- Prefix with "cabal-script-" to make it clear to end users that the name may be mangled - scriptExeName = "cabal-script-" ++ map censor (takeFileName scriptPath) - censor c | c `S.member` ccNamecore = c - | otherwise = '_' - sourcePackage = fakeProjectSourcePackage projectRoot & lSrcpkgDescription . L.condExecutables - .~ [(fromString scriptExeName, CondNode executable (targetBuildDepends $ buildInfo executable) [])] + .~ [(scriptComponenetName scriptPath, CondNode executable (targetBuildDepends $ buildInfo executable) [])] executable = scriptExecutable & L.modulePath .~ absScript @@ -395,6 +449,15 @@ fakeProjectSourcePackage projectRoot = sourcePackage , licenseRaw = Left SPDX.NONE } +-- | Find the path of an exe that has been relocated with a "-o" option +movedExePath :: UnqualComponentName -> DistDirLayout -> ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> Maybe FilePath +movedExePath selectedComponent distDirLayout elabShared elabConfigured = do + exe <- find ((== selectedComponent) . exeName) . executables $ elabPkgDescription elabConfigured + let CompilerId flavor _ = (compilerId . pkgConfigCompiler) elabShared + opts <- lookup flavor (perCompilerFlavorToList . options $ buildInfo exe) + let projectRoot = distProjectRootDirectory distDirLayout + fmap (projectRoot ) . lookup "-o" $ reverse (zip opts (drop 1 opts)) + -- Lenses -- | A lens for the 'srcpkgDescription' field of 'SourcePackage' lSrcpkgDescription :: Lens' (SourcePackage loc) GenericPackageDescription diff --git a/cabal-testsuite/PackageTests/ListBin/Script/cabal.out b/cabal-testsuite/PackageTests/ListBin/Script/cabal.out index dcb26e397f1..63d1cab2c01 100644 --- a/cabal-testsuite/PackageTests/ListBin/Script/cabal.out +++ b/cabal-testsuite/PackageTests/ListBin/Script/cabal.out @@ -2,5 +2,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -/cabal.dist/work/./dist/build//ghc-/fake-package-0/x/cabal-script-script.hs/build/cabal-script-script.hs/cabal-script-script.hs + - fake-package-0 (exe:script-script.hs) (first run) +/cabal.dist/work/./dist/build//ghc-/fake-package-0/x/script-script.hs/bin/cabal-script-script.hs diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out index 0c647f80d90..282562011fa 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/Script/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out index 71653f09844..e492d1b1f88 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.out @@ -2,10 +2,10 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (ephemeral targets) + - fake-package-0 (exe:script-script.hs) (ephemeral targets) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs index f09f7f8a4fa..9c0f021da5d 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRepl/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest . void $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do cabal' "v2-build" ["script.hs"] cabalWithStdin "v2-repl" ["script.hs"] "" diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out index 208af7b3a0b..097822b36ab 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. -# cabal v2-run \ No newline at end of file + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. +# cabal v2-run diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs index 23d49e3f73f..e46b56d4afd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptBuildRun/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest . void $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do cabal' "v2-build" ["script.hs"] cabal' "v2-run" ["script.hs"] diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out index ff6bbcc5c6e..680900c3692 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdBuild/ScriptRerun/cabal.out @@ -2,8 +2,8 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-build Up to date diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out index 634c825fcf9..9e0eab19a2b 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Keep/cabal.out @@ -2,14 +2,14 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script2.hs) (first run) -Configuring executable 'cabal-script-script2.hs' for fake-package-0.. -Building executable 'cabal-script-script2.hs' for fake-package-0.. + - fake-package-0 (exe:script-script2.hs) (first run) +Configuring executable 'script-script2.hs' for fake-package-0.. +Building executable 'script-script2.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out index 634c825fcf9..9e0eab19a2b 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Orphan/cabal.out @@ -2,14 +2,14 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-build Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script2.hs) (first run) -Configuring executable 'cabal-script-script2.hs' for fake-package-0.. -Building executable 'cabal-script-script2.hs' for fake-package-0.. + - fake-package-0 (exe:script-script2.hs) (first run) +Configuring executable 'script-script2.hs' for fake-package-0.. +Building executable 'script-script2.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out index 9075c0f276a..becc8985243 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdClean/Script/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-clean diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out index cba93d1cfd8..369c11213fd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/Script/cabal.out @@ -2,5 +2,5 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out index 135f9694e0e..eb2e5aed262 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRepl/ScriptRerun/cabal.out @@ -2,9 +2,9 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. # cabal v2-repl Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) + - fake-package-0 (exe:script-script.hs) (first run) diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out index 0cc95e6299f..5379babf9c4 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Script/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out index 7520d95a5a0..d0c7fb13eb4 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.lhs) (first run) -Configuring executable 'cabal-script-script.lhs' for fake-package-0.. -Building executable 'cabal-script-script.lhs' for fake-package-0.. + - fake-package-0 (exe:script-script.lhs) (first run) +Configuring executable 'script-script.lhs' for fake-package-0.. +Building executable 'script-script.lhs' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs index 1754c7cb4a5..64c858e8d0d 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptLiterate/cabal.test.hs @@ -1,8 +1,5 @@ import Test.Cabal.Prelude main = cabalTest $ do - isWin <- isWindows - ghc94 <- isGhcVersion "== 9.4.*" - expectBrokenIf (isWin && ghc94) 8451 $ do res <- cabal' "v2-run" ["script.lhs"] assertOutputContains "Hello World" res diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out index e0e127886ed..0a3810d6240 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptNoExtension/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-with_sp) (first run) -Configuring executable 'cabal-script-with_sp' for fake-package-0.. -Building executable 'cabal-script-with_sp' for fake-package-0.. + - fake-package-0 (exe:script-with_sp) (first run) +Configuring executable 'script-with_sp' for fake-package-0.. +Building executable 'script-with_sp' for fake-package-0.. diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out index 5384fa3bbe5..412392689bd 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptRerun/cabal.out @@ -2,7 +2,7 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - - fake-package-0 (exe:cabal-script-script.hs) (first run) -Configuring executable 'cabal-script-script.hs' for fake-package-0.. -Building executable 'cabal-script-script.hs' for fake-package-0.. + - fake-package-0 (exe:script-script.hs) (first run) +Configuring executable 'script-script.hs' for fake-package-0.. +Building executable 'script-script.hs' for fake-package-0.. # cabal v2-run diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out index ec27da9398e..24962dc65ab 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/ScriptWithProjectBlock/cabal.out @@ -2,6 +2,6 @@ Resolving dependencies... Build profile: -w ghc- -O2 In order, the following will be built: - - fake-package-0 (exe:cabal-script-s.hs) (first run) -Configuring executable 'cabal-script-s.hs' for fake-package-0.. -Building executable 'cabal-script-s.hs' for fake-package-0.. + - fake-package-0 (exe:script-s.hs) (first run) +Configuring executable 'script-s.hs' for fake-package-0.. +Building executable 'script-s.hs' for fake-package-0.. diff --git a/cabal-testsuite/cabal-testsuite.cabal b/cabal-testsuite/cabal-testsuite.cabal index e3ba1da7cbb..a1181acd945 100644 --- a/cabal-testsuite/cabal-testsuite.cabal +++ b/cabal-testsuite/cabal-testsuite.cabal @@ -60,7 +60,7 @@ library , aeson ^>= 1.4.2.0 || ^>=1.5.0.0 || ^>= 2.0.0.0 || ^>= 2.1.0.0 , async ^>= 2.2.1 , attoparsec ^>= 0.13.2.2 || ^>=0.14.1 - , base16-bytestring ^>= 0.1.1.6 || ^>= 1.0.0.0 + , base64-bytestring ^>= 1.0.0.0 || ^>= 1.1.0.0 || ^>= 1.2.0.0 , bytestring ^>= 0.10.0.2 || ^>= 0.11.0.0 , containers ^>= 0.5.0.0 || ^>= 0.6.0.1 , cryptohash-sha256 ^>= 0.11.101.0 diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 4ad7b68d116..fd6992d258d 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -52,7 +52,7 @@ import Control.Monad (unless, when, void, forM_, liftM2, liftM4) import Control.Monad.Trans.Reader (withReaderT, runReaderT) import Control.Monad.IO.Class (MonadIO (..)) 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 C import Data.List (isInfixOf, stripPrefix, isPrefixOf, intercalate) import Data.List.NonEmpty (NonEmpty (..)) @@ -841,7 +841,8 @@ getScriptCacheDirectory :: FilePath -> TestM FilePath getScriptCacheDirectory script = do cabalDir <- testCabalDir `fmap` getTestEnv hashinput <- liftIO $ canonicalizePath script - let hash = C.unpack . Base16.encode . SHA256.hash . C.pack $ hashinput + let hash = map (\c -> if c == '/' then '%' else c) . take 26 + . C.unpack . Base64.encode . SHA256.hash . C.pack $ hashinput return $ cabalDir "script-builds" hash ------------------------------------------------------------------------ diff --git a/changelog.d/issue-8841 b/changelog.d/issue-8841 new file mode 100644 index 00000000000..b0bc13c1bc2 --- /dev/null +++ b/changelog.d/issue-8841 @@ -0,0 +1,15 @@ +synopsis: Shorten script-builds paths +packages: Cabal cabal-install +prs: #8898 +issues: #8841 + +description: { + +- Use Base64 hash truncated to 26 chars for script-build cache directories. +- Use the cache directory as the dist directory. +- Use script- as the component name instead of cabal-script-<...>. +- Use cabal-script- for the executable name. +- This change is incompatible with previous cabal versions in terms of cache location, + you should manually remove your old caches once you no longer need them. + +}