From ffb4c5becf89d57560dd6f48f7693b2fdb9de6f9 Mon Sep 17 00:00:00 2001 From: Mac Malone Date: Mon, 30 Sep 2024 19:59:36 -0400 Subject: [PATCH] feat: lake: Reservoir build cache (#5486) Adds Reservoir as another possible source of build caches in addition to GitHub releases. If a GitHub release is not configured for a Reservoir dependency, it will attempt download a build cache from Reservoir. Like with GitHub releases, failure will not stop the build and instead issue a warning. Many of the Lake API calls related to these build caches were refactored and renamed, with the old names remaining around as deprecated aliases. Build cache downloads (from Reservoir or GitHub) can now be disabled via the `--no-cache` CLI option or the `LAKE_NO_CACHE` environment variable. A disabled cache can be re-enable with the `--try-cache` CLI option. --- src/lake/Lake/Build/Actions.lean | 11 +- src/lake/Lake/Build/Basic.lean | 3 + src/lake/Lake/Build/Facets.lean | 46 ++++- src/lake/Lake/Build/Info.lean | 34 +++- src/lake/Lake/Build/Package.lean | 185 ++++++++++++++---- src/lake/Lake/CLI/Help.lean | 2 + src/lake/Lake/CLI/Main.lean | 5 +- src/lake/Lake/Config/Env.lean | 20 +- src/lake/Lake/Config/Monad.lean | 4 + src/lake/Lake/Config/Package.lean | 12 +- src/lake/Lake/Load/Config.lean | 4 +- src/lake/Lake/Load/Lean.lean | 3 +- src/lake/Lake/Load/Materialize.lean | 25 +-- src/lake/Lake/Load/Package.lean | 4 +- src/lake/Lake/Load/Resolve.lean | 3 +- src/lake/Lake/Load/Toml.lean | 13 +- src/lake/Lake/Reservoir.lean | 57 ++++-- src/lake/tests/noRelease/test.sh | 6 +- src/lake/tests/online/barrel.lean | 7 + .../online/{lakefile.lean => require.lean} | 0 .../online/{lakefile.toml => require.toml} | 0 src/lake/tests/online/test.sh | 29 ++- 22 files changed, 366 insertions(+), 107 deletions(-) create mode 100644 src/lake/tests/online/barrel.lean rename src/lake/tests/online/{lakefile.lean => require.lean} (100%) rename src/lake/tests/online/{lakefile.toml => require.toml} (100%) diff --git a/src/lake/Lake/Build/Actions.lean b/src/lake/Lake/Build/Actions.lean index 44be2002ea..28ae124fc6 100644 --- a/src/lake/Lake/Build/Actions.lean +++ b/src/lake/Lake/Build/Actions.lean @@ -108,15 +108,16 @@ def compileExe } /-- Download a file using `curl`, clobbering any existing file. -/ -def download (url : String) (file : FilePath) : LogIO PUnit := do +def download + (url : String) (file : FilePath) (headers : Array String := #[]) +: LogIO PUnit := do if (← file.pathExists) then IO.FS.removeFile file else createParentDirs file - proc (quiet := true) { - cmd := "curl" - args := #["-s", "-S", "-f", "-o", file.toString, "-L", url] - } + let args := #["-s", "-S", "-f", "-o", file.toString, "-L", url] + let args := headers.foldl (init := args) (· ++ #["-H", ·]) + proc (quiet := true) {cmd := "curl", args} /-- Unpack an archive `file` using `tar` into the directory `dir`. -/ def untar (file : FilePath) (dir : FilePath) (gzip := true) : LogIO PUnit := do diff --git a/src/lake/Lake/Build/Basic.lean b/src/lake/Lake/Build/Basic.lean index 39ca795165..cabed7f250 100644 --- a/src/lake/Lake/Build/Basic.lean +++ b/src/lake/Lake/Build/Basic.lean @@ -17,10 +17,13 @@ def noBuildCode : ExitCode := 3 /-- Configuration options for a Lake build. -/ structure BuildConfig where + /-- Use modification times for trace checking. -/ oldMode : Bool := false + /-- Whether to trust `.hash` files. -/ trustHash : Bool := true /-- Early exit if a target has to be rebuilt. -/ noBuild : Bool := false + /-- Verbosity level (`-q`, `-v`, or neither). -/ verbosity : Verbosity := .normal /-- Fail the top-level build if entries of at least this level have been logged. diff --git a/src/lake/Lake/Build/Facets.lean b/src/lake/Lake/Build/Facets.lean index 67c32462bb..663db80c67 100644 --- a/src/lake/Lake/Build/Facets.lean +++ b/src/lake/Lake/Build/Facets.lean @@ -117,19 +117,53 @@ module_data o.noexport : BuildJob FilePath /-! ## Package Facets -/ /-- -A package's *optional* cloud build release. -Will not cause the whole build to fail if the release cannot be fetched. +A package's *optional* cached build archive (e.g., from Reservoir or GitHub). +Will NOT cause the whole build to fail if the archive cannot be fetched. -/ -abbrev Package.optReleaseFacet := `optRelease -package_data optRelease : BuildJob Bool +abbrev Package.optBuildCacheFacet := `optCache +package_data optCache : BuildJob Bool /-- -A package's cloud build release. +A package's cached build archive (e.g., from Reservoir or GitHub). +Will cause the whole build to fail if the archive cannot be fetched. +-/ +abbrev Package.buildCacheFacet := `cache +package_data cache : BuildJob Unit + +/-- +A package's *optional* build archive from Reservoir. +Will NOT cause the whole build to fail if the barrel cannot be fetched. +-/ +abbrev Package.optReservoirBarrelFacet := `optBarrel +package_data optBarrel : BuildJob Bool + +/-- +A package's Reservoir build archive from Reservoir. +Will cause the whole build to fail if the barrel cannot be fetched. +-/ +abbrev Package.reservoirBarrelFacet := `barrel +package_data barrel : BuildJob Unit + +/-- +A package's *optional* build archive from a GitHub release. +Will NOT cause the whole build to fail if the release cannot be fetched. +-/ +abbrev Package.optGitHubReleaseFacet := `optRelease +package_data optRelease : BuildJob Bool + +@[deprecated (since := "2024-09-27")] +abbrev Package.optReleaseFacet := optGitHubReleaseFacet + +/-- +A package's build archive from a GitHub release. Will cause the whole build to fail if the release cannot be fetched. -/ -abbrev Package.releaseFacet := `release +abbrev Package.gitHubReleaseFacet := `release package_data release : BuildJob Unit +@[deprecated (since := "2024-09-27")] +abbrev Package.releaseFacet := gitHubReleaseFacet + /-- A package's `extraDepTargets` mixed with its transitive dependencies'. -/ abbrev Package.extraDepFacet := `extraDep package_data extraDep : BuildJob Unit diff --git a/src/lake/Lake/Build/Info.lean b/src/lake/Lake/Build/Info.lean index 9427e367b1..fcc2f517cf 100644 --- a/src/lake/Lake/Build/Info.lean +++ b/src/lake/Lake/Build/Info.lean @@ -216,13 +216,35 @@ end Module abbrev Package.facet (facet : Name) (self : Package) : BuildInfo := .packageFacet self facet -@[inherit_doc releaseFacet] -abbrev Package.release (self : Package) : BuildInfo := - self.facet releaseFacet +@[inherit_doc buildCacheFacet] +abbrev Package.buildCache (self : Package) : BuildInfo := + self.facet buildCacheFacet -@[inherit_doc optReleaseFacet] -abbrev Package.optRelease (self : Package) : BuildInfo := - self.facet optReleaseFacet +@[inherit_doc optBuildCacheFacet] +abbrev Package.optBuildCache (self : Package) : BuildInfo := + self.facet optBuildCacheFacet + +@[inherit_doc reservoirBarrelFacet] +abbrev Package.reservoirBarrel (self : Package) : BuildInfo := + self.facet reservoirBarrelFacet + +@[inherit_doc optReservoirBarrelFacet] +abbrev Package.optReservoirBarrel (self : Package) : BuildInfo := + self.facet optReservoirBarrelFacet + +@[inherit_doc gitHubReleaseFacet] +abbrev Package.gitHubRelease (self : Package) : BuildInfo := + self.facet gitHubReleaseFacet + +@[inherit_doc optGitHubReleaseFacet] +abbrev Package.optGitHubRelease (self : Package) : BuildInfo := + self.facet optGitHubReleaseFacet + +@[deprecated (since := "2024-09-27")] +abbrev Package.release := @gitHubRelease + +@[deprecated (since := "2024-09-27")] +abbrev Package.optRelease := @optGitHubRelease @[inherit_doc extraDepFacet] abbrev Package.extraDep (self : Package) : BuildInfo := diff --git a/src/lake/Lake/Build/Package.lean b/src/lake/Lake/Build/Package.lean index 03bdb30895..da268d950e 100644 --- a/src/lake/Lake/Build/Package.lean +++ b/src/lake/Lake/Build/Package.lean @@ -7,6 +7,7 @@ import Lake.Util.Git import Lake.Util.Sugar import Lake.Build.Common import Lake.Build.Targets +import Lake.Reservoir /-! # Package Facet Builds Build function definitions for a package's builtin facets. @@ -24,14 +25,44 @@ def Package.recComputeDeps (self : Package) : FetchM (Array Package) := do def Package.depsFacetConfig : PackageFacetConfig depsFacet := mkFacetConfig Package.recComputeDeps -/-- Tries to download and unpack the package's prebuilt release archive (from GitHub). -/ -def Package.fetchOptRelease (self : Package) : FetchM (BuildJob Unit) := do - (← self.optRelease.fetch).bindSync fun success t => do +/-- +Tries to download and unpack the package's cached build archive +(e.g., from Reservoir or GitHub). +-/ +private def Package.fetchOptBuildCacheCore (self : Package) : FetchM (BuildJob Bool) := do + if self.preferReleaseBuild then + self.optGitHubRelease.fetch + else + self.optReservoirBarrel.fetch + +/-- The `PackageFacetConfig` for the builtin `optBuildCacheFacet`. -/ +def Package.optBuildCacheFacetConfig : PackageFacetConfig optBuildCacheFacet := + mkFacetJobConfig (·.fetchOptBuildCacheCore) + +/-- Tries to download the package's build cache (if configured). -/ +def Package.maybeFetchBuildCache (self : Package) : FetchM (BuildJob Bool) := do + if (← getNoCache) then + return pure true + else + self.optBuildCache.fetch + +/-- +Tries to download and unpack the package's cached build archive +(e.g., from Reservoir or GitHub). Prints a warning on failure. +-/ +def Package.maybeFetchBuildCacheWithWarning (self : Package) := do + let job ← self.maybeFetchBuildCache + job.bindSync fun success t => do unless success do + let facet := if self.preferReleaseBuild then + optGitHubReleaseFacet else optReservoirBarrelFacet logWarning s!"building from source; \ - failed to fetch cloud release (see '{self.name}:optRelease' for details)" + failed to fetch cloud release (see '{self.name}:{facet}' for details)" return ((), t) +@[deprecated maybeFetchBuildCacheWithWarning (since := "2024-09-27")] +def Package.fetchOptRelease := @maybeFetchBuildCacheWithWarning + /-- Build the `extraDepTargets` for the package and its transitive dependencies. Also fetch pre-built releases for the package's' dependencies. @@ -42,9 +73,9 @@ def Package.recBuildExtraDepTargets (self : Package) : FetchM (BuildJob Unit) := -- Build dependencies' extra dep targets for dep in self.deps do job := job.mix <| ← dep.extraDep.fetch - -- Fetch pre-built release if desired and this package is a dependency - if self.name ≠ (← getWorkspace).root.name ∧ self.preferReleaseBuild then - job := job.add <| ← self.fetchOptRelease + -- Fetch build cache if this package is a dependency + if self.name ≠ (← getWorkspace).root.name then + job := job.add <| ← self.maybeFetchBuildCacheWithWarning -- Build this package's extra dep targets for target in self.extraDepTargets do job := job.mix <| ← self.fetchTargetJob target @@ -54,60 +85,126 @@ def Package.recBuildExtraDepTargets (self : Package) : FetchM (BuildJob Unit) := def Package.extraDepFacetConfig : PackageFacetConfig extraDepFacet := mkFacetJobConfig Package.recBuildExtraDepTargets -/-- Tries to download and unpack the package's prebuilt release archive (from GitHub). -/ -def Package.fetchOptReleaseCore (self : Package) : FetchM (BuildJob Bool) := - withRegisterJob s!"{self.name}:optRelease" (optional := true) <| Job.async do +/-- Compute the package's Reservoir barrel URL. -/ +def Package.getBarrelUrl (self : Package) : JobM String := do + if self.scope.isEmpty then + error "package has no Reservoir scope" + let repo := GitRepo.mk self.dir + let some rev ← repo.getHeadRevision? + | error "failed to resolve HEAD revision" + let pkgName := self.name.toString (escape := false) + let env ← getLakeEnv + let mut url := Reservoir.pkgApiUrl env self.scope pkgName + if env.toolchain.isEmpty then + error "Lean toolchain not known; Reservoir only hosts builds for known toolchains" + url := s!"{url}/barrel?rev={rev}&toolchain={uriEncode env.toolchain}" + return url + +/-- Compute the package's GitHub release URL. -/ +def Package.getReleaseUrl (self : Package) : JobM String := do let repo := GitRepo.mk self.dir let repoUrl? := self.releaseRepo? <|> self.remoteUrl? let some repoUrl := repoUrl? <|> (← repo.getFilteredRemoteUrl?) - | logError s!"release repository URL not known; \ + | error "release repository URL not known; \ the package may need to set 'releaseRepo'" - updateAction .fetch - return (false, .nil) let some tag ← repo.findTag? | let rev ← if let some rev ← repo.getHeadRevision? then pure s!" '{rev}'" else pure "" - logError s!"no release tag found for revision{rev}" - updateAction .fetch - return (false, .nil) - let url := s!"{repoUrl}/releases/download/{tag}/{self.buildArchive}" + error s!"no release tag found for revision{rev}" + return s!"{repoUrl}/releases/download/{tag}/{self.buildArchive}" + +/-- Tries to download and unpack a build archive for the package from a URL. -/ +def Package.fetchBuildArchive + (self : Package) (url : String) (archiveFile : FilePath) + (headers : Array String := #[]) +: JobM PUnit := do let depTrace := Hash.ofString url - let traceFile := FilePath.mk <| self.buildArchiveFile.toString ++ ".trace" - let upToDate ← buildUnlessUpToDate? (action := .fetch) self.buildArchiveFile depTrace traceFile do - logVerbose s!"downloading {url}" - download url self.buildArchiveFile + let traceFile := archiveFile.addExtension "trace" + let upToDate ← buildUnlessUpToDate? (action := .fetch) archiveFile depTrace traceFile do + download url archiveFile headers unless upToDate && (← self.buildDir.pathExists) do updateAction .fetch - logVerbose s!"unpacking {self.name}:{tag}:{self.buildArchive}" - untar self.buildArchiveFile self.buildDir - return (true, .nil) + untar archiveFile self.buildDir -/-- The `PackageFacetConfig` for the builtin `optReleaseFacet`. -/ -def Package.optReleaseFacetConfig : PackageFacetConfig optReleaseFacet := - mkFacetJobConfig (·.fetchOptReleaseCore) +@[inline] +private def Package.mkOptBuildArchiveFacetConfig + {facet : Name} (archiveFile : Package → FilePath) + (getUrl : Package → JobM String) (headers : Array String := #[]) + [FamilyDef PackageData facet (BuildJob Bool)] +: PackageFacetConfig facet := mkFacetJobConfig fun pkg => + withRegisterJob s!"{pkg.name}:{facet}" (optional := true) <| Job.async do + try + let url ← getUrl pkg + pkg.fetchBuildArchive url (archiveFile pkg) headers + return (true, .nil) + catch _ => + updateAction .fetch + return (false, .nil) -/-- The `PackageFacetConfig` for the builtin `releaseFacet`. -/ -def Package.releaseFacetConfig : PackageFacetConfig releaseFacet := +@[inline] +private def Package.mkBuildArchiveFacetConfig + {facet : Name} (optFacet : Name) (what : String) + [FamilyDef PackageData facet (BuildJob Unit)] + [FamilyDef PackageData optFacet (BuildJob Bool)] +: PackageFacetConfig facet := mkFacetJobConfig fun pkg => - withRegisterJob s!"{pkg.name}:release" do - (← pkg.optRelease.fetch).bindSync fun success t => do + withRegisterJob s!"{pkg.name}:{facet}" do + (← fetch <| pkg.facet optFacet).bindSync fun success t => do unless success do - error s!"failed to fetch cloud release (see '{pkg.name}:optRelease' for details)" + error s!"failed to fetch {what} (see '{pkg.name}:{optFacet}' for details)" return ((), t) -/-- Perform a build job after first checking for an (optional) cloud release for the package. -/ -def Package.afterReleaseAsync (self : Package) (build : SpawnM (Job α)) : FetchM (Job α) := do - if self.preferReleaseBuild ∧ self.name ≠ (← getRootPackage).name then - (← self.optRelease.fetch).bindAsync fun _ _ => build +/-- The `PackageFacetConfig` for the builtin `buildCacheFacet`. -/ +def Package.buildCacheFacetConfig : PackageFacetConfig buildCacheFacet := + mkBuildArchiveFacetConfig optBuildCacheFacet "build cache" + +/-- The `PackageFacetConfig` for the builtin `optReservoirBarrelFacet`. -/ +def Package.optBarrelFacetConfig : PackageFacetConfig optReservoirBarrelFacet := + mkOptBuildArchiveFacetConfig barrelFile getBarrelUrl Reservoir.lakeHeaders + +/-- The `PackageFacetConfig` for the builtin `reservoirBarrelFacet`. -/ +def Package.barrelFacetConfig : PackageFacetConfig reservoirBarrelFacet := + mkBuildArchiveFacetConfig optReservoirBarrelFacet "Reservoir barrel" + +/-- The `PackageFacetConfig` for the builtin `optGitHubReleaseFacet`. -/ +def Package.optGitHubReleaseFacetConfig : PackageFacetConfig optGitHubReleaseFacet := + mkOptBuildArchiveFacetConfig buildArchiveFile getReleaseUrl + +@[deprecated (since := "2024-09-27")] +abbrev Package.optReleaseFacetConfig := optGitHubReleaseFacetConfig + +/-- The `PackageFacetConfig` for the builtin `gitHubReleaseFacet`. -/ +def Package.gitHubReleaseFacetConfig : PackageFacetConfig gitHubReleaseFacet := + mkBuildArchiveFacetConfig optGitHubReleaseFacet "GitHub release" + +@[deprecated (since := "2024-09-27")] +abbrev Package.releaseFacetConfig := gitHubReleaseFacetConfig + +/-- +Perform a build job after first checking for an (optional) cached build +for the package (e.g., from Reservoir or GitHub). +-/ +def Package.afterBuildCacheAsync (self : Package) (build : SpawnM (Job α)) : FetchM (Job α) := do + if self.name ≠ (← getRootPackage).name then + (← self.maybeFetchBuildCache).bindAsync fun _ _ => build else build -/-- Perform a build after first checking for an (optional) cloud release for the package. -/ -def Package.afterReleaseSync (self : Package) (build : JobM α) : FetchM (Job α) := do - if self.preferReleaseBuild ∧ self.name ≠ (← getRootPackage).name then - (← self.optRelease.fetch).bindSync fun _ _ => build +@[deprecated afterBuildCacheAsync (since := "2024-09-27")] +def Package.afterReleaseAsync := @afterBuildCacheAsync + +/-- + Perform a build after first checking for an (optional) cached build + for the package (e.g., from Reservoir or GitHub). +-/ +def Package.afterBuildCacheSync (self : Package) (build : JobM α) : FetchM (Job α) := do + if self.name ≠ (← getRootPackage).name then + (← self.maybeFetchBuildCache).bindSync fun _ _ => build else Job.async build +@[deprecated afterBuildCacheSync (since := "2024-09-27")] +def Package.afterReleaseSync := @afterBuildCacheSync + open Package in /-- A package facet name to build function map that contains builders for @@ -117,5 +214,9 @@ def initPackageFacetConfigs : DNameMap PackageFacetConfig := DNameMap.empty |>.insert depsFacet depsFacetConfig |>.insert extraDepFacet extraDepFacetConfig - |>.insert optReleaseFacet optReleaseFacetConfig - |>.insert releaseFacet releaseFacetConfig + |>.insert optBuildCacheFacet optBuildCacheFacetConfig + |>.insert buildCacheFacet buildCacheFacetConfig + |>.insert optReservoirBarrelFacet optBarrelFacetConfig + |>.insert reservoirBarrelFacet barrelFacetConfig + |>.insert optGitHubReleaseFacet optGitHubReleaseFacetConfig + |>.insert gitHubReleaseFacet gitHubReleaseFacetConfig diff --git a/src/lake/Lake/CLI/Help.lean b/src/lake/Lake/CLI/Help.lean index cc6a1294eb..23c01a5b1b 100644 --- a/src/lake/Lake/CLI/Help.lean +++ b/src/lake/Lake/CLI/Help.lean @@ -48,6 +48,8 @@ BASIC OPTIONS: --update, -U update manifest before building --reconfigure, -R elaborate configuration files instead of using OLeans --no-build exit immediately if a build target is not up-to-date + --no-cache build packages locally; do not download build caches + --try-cache attempt to download build caches for supported packages OUTPUT OPTIONS: --quiet, -q hide informational logs and the progress indicator diff --git a/src/lake/Lake/CLI/Main.lean b/src/lake/Lake/CLI/Main.lean index 5b7d16c9aa..5b24a9d59c 100644 --- a/src/lake/Lake/CLI/Main.lean +++ b/src/lake/Lake/CLI/Main.lean @@ -40,6 +40,7 @@ structure LakeOptions where oldMode : Bool := false trustHash : Bool := true noBuild : Bool := false + noCache : Option Bool := none failLv : LogLevel := .error outLv? : Option LogLevel := .none ansiMode : AnsiMode := .auto @@ -66,7 +67,7 @@ def LakeOptions.getInstall (opts : LakeOptions) : Except CliError (LeanInstall /-- Compute the Lake environment based on `opts`. Error if an install is missing. -/ def LakeOptions.computeEnv (opts : LakeOptions) : EIO CliError Lake.Env := do Env.compute (← opts.getLakeInstall) (← opts.getLeanInstall) opts.elanInstall? - |>.adaptExcept fun msg => .invalidEnv msg + opts.noCache |>.adaptExcept fun msg => .invalidEnv msg /-- Make a `LoadConfig` from a `LakeOptions`. -/ def LakeOptions.mkLoadConfig (opts : LakeOptions) : EIO CliError LoadConfig := @@ -173,6 +174,8 @@ def lakeLongOption : (opt : String) → CliM PUnit | "--reconfigure" => modifyThe LakeOptions ({· with reconfigure := true}) | "--old" => modifyThe LakeOptions ({· with oldMode := true}) | "--no-build" => modifyThe LakeOptions ({· with noBuild := true}) +| "--no-cache" => modifyThe LakeOptions ({· with noCache := true}) +| "--try-cache" => modifyThe LakeOptions ({· with noCache := false}) | "--rehash" => modifyThe LakeOptions ({· with trustHash := false}) | "--wfail" => modifyThe LakeOptions ({· with failLv := .warning}) | "--iofail" => modifyThe LakeOptions ({· with failLv := .info}) diff --git a/src/lake/Lake/Config/Env.lean b/src/lake/Lake/Config/Env.lean index dd23216354..d150818236 100644 --- a/src/lake/Lake/Config/Env.lean +++ b/src/lake/Lake/Config/Env.lean @@ -31,6 +31,11 @@ structure Env where githashOverride : String /-- A name-to-URL mapping of URL overrides for the named packages. -/ pkgUrlMap : NameMap String + /-- + Whether to disable downloading build caches for packages. Set via `LAKE_NO_CACHE`. + Can be overridden on a per-command basis with`--try-cache`. + -/ + noCache : Bool /-- The initial Elan toolchain of the environment (i.e., `ELAN_TOOLCHAIN`). -/ initToolchain : String /-- The initial Lean library search path of the environment (i.e., `LEAN_PATH`). -/ @@ -45,13 +50,20 @@ structure Env where namespace Env -/-- Compute an `Lake.Env` object from the given installs and set environment variables. -/ -def compute (lake : LakeInstall) (lean : LeanInstall) (elan? : Option ElanInstall) : EIO String Env := do +/-- +Compute a `Lake.Env` object from the given installs +and the set environment variables. +-/ +def compute + (lake : LakeInstall) (lean : LeanInstall) (elan? : Option ElanInstall) + (noCache : Option Bool := none) +: EIO String Env := do let reservoirBaseUrl ← getUrlD "RESERVOIR_API_BASE_URL" "https://reservoir.lean-lang.org/api" return { lake, lean, elan?, pkgUrlMap := ← computePkgUrlMap reservoirApiUrl := ← getUrlD "RESERVOIR_API_URL" s!"{reservoirBaseUrl}/v1" + noCache := (noCache <|> (← IO.getEnv "LAKE_NO_CACHE").bind toBool?).getD false githashOverride := (← IO.getEnv "LEAN_GITHASH").getD "" initToolchain := (← IO.getEnv "ELAN_TOOLCHAIN").getD "" initLeanPath := ← getSearchPath "LEAN_PATH", @@ -60,6 +72,10 @@ def compute (lake : LakeInstall) (lean : LeanInstall) (elan? : Option ElanInstal initPath := ← getSearchPath "PATH" } where + toBool? (o : String) : Option Bool := + if ["y", "yes", "t", "true", "on", "1"].contains o.toLower then true + else if ["n", "no", "f", "false", "off", "0"].contains o.toLower then false + else none computePkgUrlMap := do let some urlMapStr ← IO.getEnv "LAKE_PKG_URL_MAP" | return {} match Json.parse urlMapStr |>.bind fromJson? with diff --git a/src/lake/Lake/Config/Monad.lean b/src/lake/Lake/Config/Monad.lean index 0ac8db9607..ab5154db55 100644 --- a/src/lake/Lake/Config/Monad.lean +++ b/src/lake/Lake/Config/Monad.lean @@ -128,6 +128,10 @@ variable [MonadLakeEnv m] variable [Functor m] +/-- Get the `LAKE_NO_CACHE`/`--no-cache` LAke configuration. -/ +@[inline] def getNoCache [Functor m] [MonadBuild m] : m Bool := + (·.noCache) <$> getLakeEnv + /-- Get the `LAKE_PACKAGE_URL_MAP` for the Lake environment. Empty if none. -/ @[inline] def getPkgUrlMap : m (NameMap String) := (·.pkgUrlMap) <$> getLakeEnv diff --git a/src/lake/Lake/Config/Package.lean b/src/lake/Lake/Config/Package.lean index 30cd46b94b..2e9f6ea8f0 100644 --- a/src/lake/Lake/Config/Package.lean +++ b/src/lake/Lake/Config/Package.lean @@ -376,8 +376,10 @@ structure Package where relConfigFile : FilePath /-- The path to the package's JSON manifest of remote dependencies (relative to `dir`). -/ relManifestFile : FilePath := config.manifestFile.getD defaultManifestFile + /-- The package's scope (e.g., in Reservoir). -/ + scope : String := "" /-- The URL to this package's Git remote. -/ - remoteUrl? : Option String := none + remoteUrl : String := "" /-- (Opaque references to) the package's direct dependencies. -/ opaqueDeps : Array OpaquePackage := #[] /-- Dependency configurations for the package. -/ @@ -555,6 +557,10 @@ namespace Package @[inline] def releaseRepo? (self : Package) : Option String := self.config.releaseRepo <|> self.config.releaseRepo? +/-- The packages `remoteUrl` as an `Option` (`none` if empty). -/ +@[inline] def remoteUrl? (self : Package) : Option String := + if self.remoteUrl.isEmpty then some self.remoteUrl else none + /-- The package's `buildArchive`/`buildArchive?` configuration. -/ @[inline] def buildArchive (self : Package) : String := self.config.buildArchive @@ -563,6 +569,10 @@ namespace Package @[inline] def buildArchiveFile (self : Package) : FilePath := self.lakeDir / self.buildArchive +/-- The path where Lake stores the package's barrel (downloaded from Reservoir). -/ +@[inline] def barrelFile (self : Package) : FilePath := + self.lakeDir / "build.barrel" + /-- The package's `preferReleaseBuild` configuration. -/ @[inline] def preferReleaseBuild (self : Package) : Bool := self.config.preferReleaseBuild diff --git a/src/lake/Lake/Load/Config.lean b/src/lake/Lake/Load/Config.lean index 2de9c24661..237578cd8c 100644 --- a/src/lake/Lake/Load/Config.lean +++ b/src/lake/Lake/Load/Config.lean @@ -28,8 +28,10 @@ structure LoadConfig where leanOpts : Options := {} /-- If `true`, Lake will elaborate configuration files instead of using OLeans. -/ reconfigure : Bool := false + /-- The package's scope (e.g., in Reservoir). -/ + scope : String := "" /-- The URL to this package's Git remote (if any). -/ - remoteUrl? : Option String := none + remoteUrl : String := "" /-- The full path to loaded package's directory. -/ @[inline] def LoadConfig.pkgDir (cfg : LoadConfig) : FilePath := diff --git a/src/lake/Lake/Load/Lean.lean b/src/lake/Lake/Load/Lean.lean index 95fc736774..08aab790c3 100644 --- a/src/lake/Lake/Load/Lean.lean +++ b/src/lake/Lake/Load/Lean.lean @@ -29,6 +29,7 @@ def loadLeanConfig (cfg : LoadConfig) relDir := cfg.relPkgDir config := pkgConfig relConfigFile := cfg.relConfigFile - remoteUrl? := cfg.remoteUrl? + scope := cfg.scope + remoteUrl := cfg.remoteUrl } return (← pkg.loadFromEnv configEnv cfg.leanOpts, configEnv) diff --git a/src/lake/Lake/Load/Materialize.lean b/src/lake/Lake/Load/Materialize.lean index 9867672b8f..cf618aaf53 100644 --- a/src/lake/Lake/Load/Materialize.lean +++ b/src/lake/Lake/Load/Materialize.lean @@ -79,7 +79,7 @@ structure MaterializedDep where URL for the materialized package. Used as the endpoint from which to fetch cloud releases for the package. -/ - remoteUrl? : Option String + remoteUrl : String /-- The manifest entry for the dependency. -/ manifestEntry : PackageEntry deriving Inhabited @@ -87,6 +87,9 @@ structure MaterializedDep where @[inline] def MaterializedDep.name (self : MaterializedDep) := self.manifestEntry.name +@[inline] def MaterializedDep.scope (self : MaterializedDep) := + self.manifestEntry.scope + /-- Path to the dependency's configuration file (relative to `relPkgDir`). -/ @[inline] def MaterializedDep.manifestFile? (self : MaterializedDep) := self.manifestEntry.manifestFile? @@ -109,13 +112,13 @@ def Dependency.materialize let relPkgDir := relParentDir / dir return { relPkgDir - remoteUrl? := none + remoteUrl := "" manifestEntry := mkEntry <| .path relPkgDir } | .git url inputRev? subDir? => do let sname := dep.name.toString (escape := false) - let repoUrl? := Git.filterUrl? url - materializeGit sname (relPkgsDir / sname) url repoUrl? inputRev? subDir? + let repoUrl := Git.filterUrl? url |>.getD "" + materializeGit sname (relPkgsDir / sname) url repoUrl inputRev? subDir? else if dep.scope.isEmpty then error s!"{dep.name}: ill-formed dependency: \ @@ -126,26 +129,26 @@ def Dependency.materialize else error s!"{dep.name} unsupported dependency version format '{ver}' (should be \"git#>rev>\")" let depName := dep.name.toString (escape := false) - let some pkg ← fetchReservoirPkg? lakeEnv dep.scope depName + let some pkg ← Reservoir.fetchPkg? lakeEnv dep.scope depName | error s!"{dep.scope}/{depName}: could not materialize package: \ dependency has no explicit source and was not found on Reservoir" let relPkgDir := relPkgsDir / pkg.name match pkg.gitSrc? with | some (.git _ url githubUrl? defaultBranch? subDir?) => - materializeGit pkg.fullName relPkgDir url githubUrl? (verRev? <|> defaultBranch?) subDir? + materializeGit pkg.fullName relPkgDir url + (githubUrl?.getD "") (verRev? <|> defaultBranch?) subDir? | _ => error s!"{pkg.fullName}: Git source not found on Reservoir" where mkEntry src : PackageEntry := {name := dep.name, scope := dep.scope, inherited, src} - materializeGit name relPkgDir gitUrl remoteUrl? inputRev? subDir? : LogIO MaterializedDep := do + materializeGit name relPkgDir gitUrl remoteUrl inputRev? subDir? : LogIO MaterializedDep := do let repo := GitRepo.mk (wsDir / relPkgDir) let gitUrl := lakeEnv.pkgUrlMap.find? dep.name |>.getD gitUrl materializeGitRepo name repo gitUrl inputRev? let rev ← repo.getHeadRevision let relPkgDir := if let some subDir := subDir? then relPkgDir / subDir else relPkgDir return { - relPkgDir - remoteUrl? := remoteUrl? + relPkgDir, remoteUrl manifestEntry := mkEntry <| .git gitUrl rev inputRev? subDir? } @@ -160,7 +163,7 @@ def PackageEntry.materialize | .path (dir := relPkgDir) .. => return { relPkgDir - remoteUrl? := none + remoteUrl := "" manifestEntry } | .git (url := url) (rev := rev) (subDir? := subDir?) .. => do @@ -187,6 +190,6 @@ def PackageEntry.materialize let relPkgDir := match subDir? with | .some subDir => relGitDir / subDir | .none => relGitDir return { relPkgDir - remoteUrl? := Git.filterUrl? url + remoteUrl := Git.filterUrl? url |>.getD "" manifestEntry } diff --git a/src/lake/Lake/Load/Package.lean b/src/lake/Lake/Load/Package.lean index b287e0fd5f..26607f2d43 100644 --- a/src/lake/Lake/Load/Package.lean +++ b/src/lake/Lake/Load/Package.lean @@ -40,7 +40,7 @@ def loadPackageCore error s!"{name}: configuration file not found: {cfg.configFile}" match ext with | "lean" => (·.map id some) <$> loadLeanConfig cfg - | "toml" => ((·,none)) <$> loadTomlConfig cfg.pkgDir cfg.relPkgDir cfg.relConfigFile + | "toml" => ((·,none)) <$> loadTomlConfig cfg | _ => error s!"{name}: configuration has unsupported file extension: {cfg.configFile}" else let relLeanFile := cfg.relConfigFile.addExtension "lean" @@ -55,7 +55,7 @@ def loadPackageCore (·.map id some) <$> loadLeanConfig {cfg with relConfigFile := relLeanFile} else if tomlExists then - ((·,none)) <$> loadTomlConfig cfg.pkgDir cfg.relPkgDir relTomlFile + ((·,none)) <$> loadTomlConfig {cfg with relConfigFile := relTomlFile} else error s!"{name}: no configuration file with a supported extension:\n{leanFile}\n{tomlFile}" diff --git a/src/lake/Lake/Load/Resolve.lean b/src/lake/Lake/Load/Resolve.lean index d32470519b..a5681a42da 100644 --- a/src/lake/Lake/Load/Resolve.lean +++ b/src/lake/Lake/Load/Resolve.lean @@ -34,7 +34,8 @@ def loadDepPackage relPkgDir := dep.relPkgDir relConfigFile := dep.configFile lakeOpts, leanOpts, reconfigure - remoteUrl? := dep.remoteUrl? + scope := dep.scope + remoteUrl := dep.remoteUrl } if let some env := env? then let ws ← IO.ofExcept <| ws.addFacetsFromEnv env leanOpts diff --git a/src/lake/Lake/Load/Toml.lean b/src/lake/Lake/Load/Toml.lean index ad20492aca..79a399cd65 100644 --- a/src/lake/Lake/Load/Toml.lean +++ b/src/lake/Lake/Load/Toml.lean @@ -305,10 +305,9 @@ instance : DecodeToml Dependency := ⟨fun v => do Dependency.decodeToml (← v. Load a `Package` from a TOML Lake configuration file. The resulting package does not yet include any dependencies. -/ -def loadTomlConfig (dir relDir relConfigFile : FilePath) : LogIO Package := do - let configFile := dir / relConfigFile - let input ← IO.FS.readFile configFile - let ictx := mkInputContext input relConfigFile.toString +def loadTomlConfig (cfg: LoadConfig) : LogIO Package := do + let input ← IO.FS.readFile cfg.configFile + let ictx := mkInputContext input cfg.relConfigFile.toString match (← loadToml ictx |>.toBaseIO) with | .ok table => let (pkg, errs) := Id.run <| StateT.run (s := (#[] : Array DecodeError)) do @@ -319,7 +318,11 @@ def loadTomlConfig (dir relDir relConfigFile : FilePath) : LogIO Package := do let defaultTargets := defaultTargets.map stringToLegalOrSimpleName let depConfigs ← table.tryDecodeD `require #[] return { - dir, relDir, relConfigFile + dir := cfg.pkgDir + relDir := cfg.relPkgDir + relConfigFile := cfg.relConfigFile + scope := cfg.scope + remoteUrl := cfg.remoteUrl config, depConfigs, leanLibConfigs, leanExeConfigs defaultTargets } diff --git a/src/lake/Lake/Reservoir.lean b/src/lake/Lake/Reservoir.lean index 5f9c026a55..3fe69ba49b 100644 --- a/src/lake/Lake/Reservoir.lean +++ b/src/lake/Lake/Reservoir.lean @@ -121,19 +121,41 @@ def hexEncodeByte (b : UInt8) : Char := def uriEscapeByte (b : UInt8) (s := "") : String := s.push '%' |>.push (hexEncodeByte <| b >>> 4) |>.push (hexEncodeByte <| b &&& 0xF) -@[specialize] def utf8EncodeCharM [Monad m] (c : Char) (f : σ → UInt8 → m σ) (init : σ) : m σ := do +/-- Folds a monadic function over the UTF-8 bytes of `Char` from most significant to least significant. -/ +@[specialize] def foldlUtf8M [Monad m] (c : Char) (f : σ → UInt8 → m σ) (init : σ) : m σ := do + let s := init let v := c.val - let s ← f init <| v.toUInt8 &&& 0x3f ||| 0x80 - if v ≤ 0x7f then return s - let s ← f s <| (v >>> 6).toUInt8 &&& 0x1f ||| 0xc0 - if v ≤ 0x7ff then return s - let s ← f s <| (v >>> 12).toUInt8 &&& 0x0f ||| 0xe0 - if v ≤ 0xffff then return s - f s <| (v >>> 18).toUInt8 &&& 0x07 ||| 0xf0 + if v ≤ 0x7f then + f s v.toUInt8 + else if v ≤ 0x7ff then + let s ← f s <| (v >>> 6).toUInt8 &&& 0x1f ||| 0xc0 + let s ← f s <| v.toUInt8 &&& 0x3f ||| 0x80 + return s + else if v ≤ 0xffff then + let s ← f s <| (v >>> 12).toUInt8 &&& 0x0f ||| 0xe0 + let s ← f s <| (v >>> 6).toUInt8 &&& 0x3f ||| 0x80 + let s ← f s <| v.toUInt8 &&& 0x3f ||| 0x80 + return s + else + let s ← f s <| (v >>> 18).toUInt8 &&& 0x07 ||| 0xf0 + let s ← f s <| (v >>> 12).toUInt8 &&& 0x3f ||| 0x80 + let s ← f s <| (v >>> 6).toUInt8 &&& 0x3f ||| 0x80 + let s ← f s <| v.toUInt8 &&& 0x3f ||| 0x80 + return s + +abbrev foldlUtf8 (c : Char) (f : σ → UInt8 → σ) (init : σ) : σ := + Id.run <| foldlUtf8M c f init + +example : foldlUtf8 c (fun l b => b::l) List.nil = (String.utf8EncodeChar c).reverse := by + simp only [foldlUtf8M, String.utf8EncodeChar, Id.run] + if h1:c.val ≤ 0x7f then simp [h1] + else if h2:c.val ≤ 0x7ff then simp [h1, h2] + else if h3:c.val ≤ 0xffff then simp [h1, h2, h3] + else simp [h1, h2, h3] /-- Encode a character as a sequence of URI escape codes representing its UTF8 encoding. -/ def uriEscapeChar (c : Char) (s := "") : String := - Id.run <| utf8EncodeCharM c (init := s) fun s b => uriEscapeByte b s + foldlUtf8 c (init := s) fun s b => uriEscapeByte b s /-- A URI unreserved mark as specified in [RFC2396](https://datatracker.ietf.org/doc/html/rfc2396#section-2.3). -/ def isUriUnreservedMark (c : Char) : Bool := @@ -171,14 +193,19 @@ protected def ReservoirResp.fromJson? [FromJson α] (val : Json) : Except String instance [FromJson α] : FromJson (ReservoirResp α) := ⟨ReservoirResp.fromJson?⟩ -def fetchReservoirPkg? (lakeEnv : Lake.Env) (owner pkg : String) : LogIO (Option RegistryPkg) := do - let url := s!"{lakeEnv.reservoirApiUrl}/packages/{uriEncode owner}/{uriEncode pkg}" +def Reservoir.pkgApiUrl (lakeEnv : Lake.Env) (owner pkg : String) := + s!"{lakeEnv.reservoirApiUrl}/packages/{uriEncode owner}/{uriEncode pkg}" + +def Reservoir.lakeHeaders := #[ + "X-Reservoir-Api-Version:1.0.0", + "X-Lake-Registry-Api-Version:0.1.0" +] + +def Reservoir.fetchPkg? (lakeEnv : Lake.Env) (owner pkg : String) : LogIO (Option RegistryPkg) := do + let url := Reservoir.pkgApiUrl lakeEnv owner pkg let out ← try - getUrl url #[ - "X-Reservoir-Api-Version:1.0.0", - "X-Lake-Registry-Api-Version:0.1.0" - ] + getUrl url Reservoir.lakeHeaders catch _ => logError s!"{owner}/{pkg}: Reservoir lookup failed" return none diff --git a/src/lake/tests/noRelease/test.sh b/src/lake/tests/noRelease/test.sh index ccb5aa1bf8..26b361740b 100755 --- a/src/lake/tests/noRelease/test.sh +++ b/src/lake/tests/noRelease/test.sh @@ -35,7 +35,7 @@ REV_STR="'${INIT_REV}'" ✖ [1/2] (Optional) Fetching dep:optRelease error: no release tag found for revision ${REV_STR} ✖ [2/2] Running dep:release -error: failed to fetch cloud release (see 'dep:optRelease' for details) +error: failed to fetch GitHub release (see 'dep:optRelease' for details) Some required builds logged failures: - dep:release EOF @@ -54,7 +54,7 @@ EOF # Test download failure $LAKE update # re-fetch release tag -($LAKE build dep:release && exit 1 || true) | grep --color "downloading" +($LAKE build dep:release && exit 1 || true) | grep --color "curl" # Test automatic cloud release unpacking mkdir -p .lake/packages/dep/.lake/build @@ -62,7 +62,7 @@ $LAKE -d .lake/packages/dep pack 2>&1 | grep --color "packing" test -f .lake/packages/dep/.lake/release.tgz echo 4225503363911572621 > .lake/packages/dep/.lake/release.tgz.trace rmdir .lake/packages/dep/.lake/build -$LAKE build dep:release -v | grep --color "unpacking" +$LAKE build dep:release -v | grep --color "tar" test -d .lake/packages/dep/.lake/build # Test that the job prints nothing if the archive is already fetched and unpacked diff --git a/src/lake/tests/online/barrel.lean b/src/lake/tests/online/barrel.lean new file mode 100644 index 0000000000..4afa5e9688 --- /dev/null +++ b/src/lake/tests/online/barrel.lean @@ -0,0 +1,7 @@ +import Lake +open Lake DSL + +package test + +require "leanprover" / "Cli" + @ git "2cf1030dc2ae6b3632c84a09350b675ef3e347d0" diff --git a/src/lake/tests/online/lakefile.lean b/src/lake/tests/online/require.lean similarity index 100% rename from src/lake/tests/online/lakefile.lean rename to src/lake/tests/online/require.lean diff --git a/src/lake/tests/online/lakefile.toml b/src/lake/tests/online/require.toml similarity index 100% rename from src/lake/tests/online/lakefile.toml rename to src/lake/tests/online/require.toml diff --git a/src/lake/tests/online/test.sh b/src/lake/tests/online/test.sh index 96961eb49a..b1b94f3a5b 100755 --- a/src/lake/tests/online/test.sh +++ b/src/lake/tests/online/test.sh @@ -3,17 +3,36 @@ set -exo pipefail LAKE=${LAKE:-../../.lake/build/bin/lake} +./clean.sh +$LAKE -f barrel.lean update +# Test cache toggle +$LAKE -f barrel.lean build @Cli:extraDep | grep --color "Cli:optBarrel" +(LAKE_NO_CACHE=1 $LAKE -f barrel.lean build @Cli:extraDep) | + grep --color "Cli:optBarrel" && exit 1 || true +($LAKE -f barrel.lean build @Cli:extraDep --no-cache) | + grep --color "Cli:optBarrel" && exit 1 || true +(LAKE_NO_CACHE=1 $LAKE -f barrel.lean build @Cli:extraDep --try-cache) | + grep --color "Cli:optBarrel" +# Test barrel download +(ELAN_TOOLCHAIN= $LAKE -f barrel.lean build @Cli:barrel -v && exit 1 || true) | + grep --color "Lean toolchain not known" +ELAN_TOOLCHAIN=leanprover/lean4:v4.11.0 \ + $LAKE -f barrel.lean build @Cli:barrel -v +ELAN_TOOLCHAIN=leanprover/lean4:v4.11.0 \ +LEAN_GITHASH=ec3042d94bd11a42430f9e14d39e26b1f880f99b \ + $LAKE -f barrel.lean build Cli --no-build + ./clean.sh # Tests requiring a package not in the index -($LAKE update -f bogus-dep.toml 2>&1 && exit || true) | +($LAKE -f bogus-dep.toml update 2>&1 && exit 1 || true) | grep --color "error: bogus/bogus: could not materialize package: dependency has no explicit source and was not found on Reservoir" ./clean.sh -$LAKE update -f lakefile.lean -v +$LAKE -f require.lean update -v test -d .lake/packages/doc-gen4 -$LAKE resolve-deps -f lakefile.lean # validate manifest +$LAKE -f require.lean resolve-deps # validate manifest ./clean.sh -$LAKE update -f lakefile.toml -v +$LAKE -f require.toml update v test -d .lake/packages/doc-gen4 -$LAKE resolve-deps -f lakefile.toml # validate manifest +$LAKE -f require.toml resolve-deps # validate manifest