Network caps to track network access

Adds a [Network_cap.t] type which must be passed to the low-level
functions which require network access, and should only be created at
the "edge", either in a command or a rule. This will make it harder to
accidentally add a requirement on network access to a code path that
previously did not require network access, which will become important
for maintaining an offline mode for Dune where it avoids updating
package repositories and downloading files where possible.

Signed-off-by: Stephen Sherratt <[email protected]>

Author: gridbugs

bin/fmt.ml

@@ -13,7 +13,7 @@ let man =
   ]
 ;;
 
-let lock_ocamlformat () =
+let lock_ocamlformat network_cap =
   if Lazy.force Lock_dev_tool.is_enabled
   then
     (* Note that generating the ocamlformat lockdir here means
@@ -22,14 +22,19 @@ let lock_ocamlformat () =
        this logic remain outside of `dune build`, as `dune
        build` is intended to only build targets, and generating
        a lockdir is not building a target. *)
-    Lock_dev_tool.lock_dev_tool Ocamlformat |> Memo.run
+    Lock_dev_tool.lock_dev_tool Ocamlformat network_cap |> Memo.run
   else Fiber.return ()
 ;;
 
 let run_fmt_command ~common ~config ~preview builder =
   let open Fiber.O in
   let once () =
-    let* () = lock_ocamlformat () in
+    let network_cap =
+      Dune_pkg.Network_cap.create
+        ~reason_for_network_access:
+          "Need to download package repositories to solve dependecies of ocamlformat."
+    in
+    let* () = lock_ocamlformat network_cap in
     let request (setup : Import.Main.build_system) =
       let dir = Path.(relative root) (Common.prefix_target common ".") in
       Alias.in_dir ~name:Dune_rules.Alias.fmt ~recursive:true ~contexts:setup.contexts dir

bin/lock_dev_tool.ml

@@ -66,7 +66,7 @@ let make_local_package_wrapping_dev_tool ~dev_tool ~dev_tool_version ~extra_depe
   }
 ;;
 
-let solve ~dev_tool ~local_packages =
+let solve ~dev_tool ~local_packages network_cap =
   let open Memo.O in
   let* solver_env_from_current_system =
     Pkg.Pkg_common.poll_solver_env_from_current_system ()
@@ -91,6 +91,7 @@ let solve ~dev_tool ~local_packages =
        ~lock_dirs:[ lock_dir ]
        ~print_perf_stats:false
        ~portable_lock_dir:false
+       network_cap
 ;;
 
 let compiler_package_name = Package_name.of_string "ocaml"
@@ -236,7 +237,7 @@ let lockdir_status dev_tool =
    dev tool [dev_tool]. If [version] is [Some v] then version [v] of the tool
    will be chosen by the solver. Otherwise the solver is free to choose the
    appropriate version of the tool to install. *)
-let lock_dev_tool_at_version dev_tool version =
+let lock_dev_tool_at_version dev_tool version network_cap =
   let open Memo.O in
   let* need_to_solve =
     lockdir_status dev_tool
@@ -289,7 +290,7 @@ let lock_dev_tool_at_version dev_tool version =
         ~extra_dependencies
     in
     let local_packages = Package_name.Map.singleton local_pkg.name local_pkg in
-    solve ~dev_tool ~local_packages
+    solve ~dev_tool ~local_packages network_cap
   else Memo.return ()
 ;;
 

bin/lock_dev_tool.mli

@@ -1,4 +1,4 @@
 open Import
 
 val is_enabled : bool Lazy.t
-val lock_dev_tool : Dune_pkg.Dev_tool.t -> unit Memo.t
+val lock_dev_tool : Dune_pkg.Dev_tool.t -> Dune_pkg.Network_cap.t -> unit Memo.t

bin/ocaml/doc.ml

@@ -13,10 +13,10 @@ let man =
 
 let info = Cmd.info "doc" ~doc ~man
 
-let lock_odoc_if_dev_tool_enabled () =
+let lock_odoc_if_dev_tool_enabled network_cap =
   match Lazy.force Lock_dev_tool.is_enabled with
   | false -> Action_builder.return ()
-  | true -> Action_builder.of_memo (Lock_dev_tool.lock_dev_tool Odoc)
+  | true -> Action_builder.of_memo (Lock_dev_tool.lock_dev_tool Odoc network_cap)
 ;;
 
 let term =
@@ -25,7 +25,12 @@ let term =
   let request (setup : Main.build_system) =
     let dir = Path.(relative root) (Common.prefix_target common ".") in
     let open Action_builder.O in
-    let* () = lock_odoc_if_dev_tool_enabled () in
+    let network_cap =
+      Dune_pkg.Network_cap.create
+        ~reason_for_network_access:
+          "Need to download package repositories to solve dependecies of odoc."
+    in
+    let* () = lock_odoc_if_dev_tool_enabled network_cap in
     let+ () =
       Alias.in_dir ~name:Dune_rules.Alias.doc ~recursive:true ~contexts:setup.contexts dir
       |> Alias.request

bin/ocaml/utop.ml

@@ -13,10 +13,10 @@ let man =
 let man_xrefs = [ `Cmd "top" ]
 let info = Cmd.info "utop" ~man_xrefs ~doc ~man
 
-let lock_utop_if_dev_tool_enabled () =
+let lock_utop_if_dev_tool_enabled network_cap =
   match Lazy.force Lock_dev_tool.is_enabled with
   | false -> Memo.return ()
-  | true -> Lock_dev_tool.lock_dev_tool Utop
+  | true -> Lock_dev_tool.lock_dev_tool Utop network_cap
 ;;
 
 let term =
@@ -47,12 +47,17 @@ let term =
         in
         let utop_exe = utop_target_path Utop.utop_exe in
         let utop_findlib_conf = utop_target_path Utop.utop_findlib_conf in
+        let network_cap =
+          Dune_pkg.Network_cap.create
+            ~reason_for_network_access:
+              "Need to download package repositories to solve dependecies of utop."
+        in
         let* () =
           (* Calling [Build_system.file_exists] has the side effect of checking
              and memoizing whether or not the utop dev tool lockdir exists.
              thus if we generate the lockdir any later than this point, dune
              will not observe the fact that it now exists. *)
-          lock_utop_if_dev_tool_enabled ()
+          lock_utop_if_dev_tool_enabled network_cap
         in
         Build_system.file_exists utop_exe
         >>= function

bin/pkg/lock.ml

@@ -302,6 +302,7 @@ let solve_lock_dir
       solver_env_from_current_system
       lock_dir_path
       progress_state
+      network_cap
   =
   let open Fiber.O in
   let lock_dir = Workspace.find_lock_dir workspace lock_dir_path in
@@ -347,8 +348,9 @@ let solve_lock_dir
     Dune_pkg.Opam_repo.resolve_repositories
       ~available_repos:repo_map
       ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+      network_cap
   in
-  let* pins = resolve_project_pins project_pins in
+  let* pins = resolve_project_pins project_pins network_cap in
   let time_solve_start = Unix.gettimeofday () in
   progress_state := Some Progress_indicator.Per_lockdir.State.Solving;
   let* result =
@@ -428,7 +430,9 @@ let solve_lock_dir
            ~maybe_unsolved_platforms_message)
     in
     progress_state := None;
-    let+ lock_dir = Lock_dir.compute_missing_checksums ~pinned_packages lock_dir in
+    let+ lock_dir =
+      Lock_dir.compute_missing_checksums ~pinned_packages lock_dir network_cap
+    in
     Ok
       ( Lock_dir.Write_disk.prepare ~portable_lock_dir ~lock_dir_path ~files lock_dir
       , summary_message )
@@ -443,6 +447,7 @@ let solve
       ~lock_dirs
       ~print_perf_stats
       ~portable_lock_dir
+      network_cap
   =
   let open Fiber.O in
   (* a list of thunks that will perform all the file IO side
@@ -469,7 +474,8 @@ let solve
                 version_preference
                 solver_env_from_current_system
                 lockdir_path
-                state))
+                state
+                network_cap))
      in
      List.partition_map result ~f:Result.to_either
    in
@@ -511,7 +517,13 @@ let project_pins =
     Pin.DB.combine_exn acc pins)
 ;;
 
-let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir =
+let lock
+      ~version_preference
+      ~lock_dirs_arg
+      ~print_perf_stats
+      ~portable_lock_dir
+      network_cap
+  =
   let open Fiber.O in
   let* solver_env_from_current_system =
     poll_solver_env_from_current_system () >>| Option.some
@@ -537,6 +549,7 @@ let lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir
     ~lock_dirs
     ~print_perf_stats
     ~portable_lock_dir
+    network_cap
 ;;
 
 let term =
@@ -547,6 +560,12 @@ let term =
   and+ print_perf_stats = Arg.(value & flag & info [ "print-perf-stats" ] ~doc:None) in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
+  let network_cap =
+    Dune_pkg.Network_cap.create
+      ~reason_for_network_access:
+        "Locking dependencies requires network access because it needs to download \
+         package repositories containing metadata in order to solve dependencies."
+  in
   Scheduler.go_with_rpc_server ~common ~config (fun () ->
     let open Fiber.O in
     Pkg_common.check_pkg_management_enabled ()
@@ -556,7 +575,12 @@ let term =
       | `Enabled -> true
       | `Disabled -> false
     in
-    lock ~version_preference ~lock_dirs_arg ~print_perf_stats ~portable_lock_dir)
+    lock
+      ~version_preference
+      ~lock_dirs_arg
+      ~print_perf_stats
+      ~portable_lock_dir
+      network_cap)
 ;;
 
 let info =

bin/pkg/lock.mli

@@ -9,6 +9,7 @@ val solve
   -> lock_dirs:Path.t list
   -> print_perf_stats:bool
   -> portable_lock_dir:bool
+  -> Dune_pkg.Network_cap.t
   -> unit Fiber.t
 
 (** Command to create lock directory *)

bin/pkg/outdated.ml

@@ -1,7 +1,7 @@
 open Import
 open Pkg_common
 
-let find_outdated_packages ~transitive ~lock_dirs_arg () =
+let find_outdated_packages ~transitive ~lock_dirs_arg network_cap () =
   let open Fiber.O in
   let+ pps, not_founds =
     let* workspace = Memo.run (Workspace.workspace ()) in
@@ -13,6 +13,7 @@ let find_outdated_packages ~transitive ~lock_dirs_arg () =
         Dune_pkg.Opam_repo.resolve_repositories
           ~available_repos:(repositories_of_workspace workspace)
           ~repositories:(repositories_of_lock_dir workspace ~lock_dir_path)
+          network_cap
       and+ local_packages = Memo.run find_local_packages
       and+ platform = solver_env_from_system_and_context ~lock_dir_path in
       let lock_dir = Dune_pkg.Lock_dir.read_disk_exn lock_dir_path in
@@ -76,10 +77,16 @@ let term =
   and+ lock_dirs_arg = Pkg_common.Lock_dirs_arg.term in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
+  let network_cap =
+    Dune_pkg.Network_cap.create
+      ~reason_for_network_access:
+        "Need to download package repositories to check whether the current package \
+         solution is out of date."
+  in
   Scheduler.go_with_rpc_server ~common ~config (fun () ->
     let open Fiber.O in
     Pkg_common.check_pkg_management_enabled ()
-    >>> find_outdated_packages ~transitive ~lock_dirs_arg ())
+    >>> find_outdated_packages ~transitive ~lock_dirs_arg network_cap ())
 ;;
 
 let info =

bin/pkg/search.ml

@@ -26,7 +26,7 @@ let packages_in_repo ~query repo =
     Fiber.return (name, OpamPackage.Version.Map.max_binding_opt versions))
 ;;
 
-let search_packages ~query () =
+let search_packages ~query network_cap () =
   let open Fiber.O in
   let* workspace = Memo.run (Workspace.workspace ()) in
   let* lock_dir_path = Dune_rules.Lock_dir.get_path Context_name.default |> Memo.run in
@@ -39,6 +39,7 @@ let search_packages ~query () =
     Dune_pkg.Opam_repo.resolve_repositories
       ~available_repos:(Pkg_common.repositories_of_workspace workspace)
       ~repositories:(Pkg_common.repositories_of_lock_dir workspace ~lock_dir_path)
+      network_cap
   in
   let re = Option.map ~f:(fun q -> Re.str q |> Re.no_case |> Re.compile) query in
   let* filtered = Fiber.parallel_map ~f:(packages_in_repo ~query:re) repos in
@@ -111,9 +112,14 @@ let term =
   and+ query = Arg.(value & pos 0 (some string) None & info [] ~docv:"QUERY" ~doc:None) in
   let builder = Common.Builder.forbid_builds builder in
   let common, config = Common.init builder in
+  let network_cap =
+    Dune_pkg.Network_cap.create
+      ~reason_for_network_access:
+        "Package repositories need to be downloaded in order to search them."
+  in
   Scheduler.go_with_rpc_server ~common ~config (fun () ->
     let open Fiber.O in
-    Pkg_common.check_pkg_management_enabled () >>> search_packages ~query ())
+    Pkg_common.check_pkg_management_enabled () >>> search_packages ~query network_cap ())
 ;;
 
 let info =

bin/tools/tools_common.ml

@@ -19,12 +19,14 @@ let dev_tool_build_target dev_tool =
        (Path.to_string (dev_tool_exe_path dev_tool)))
 ;;
 
-let build_dev_tool_directly common dev_tool =
+let build_dev_tool_directly common dev_tool network_cap =
   let open Fiber.O in
   let+ result =
     Build.run_build_system ~common ~request:(fun _build_system ->
       let open Action_builder.O in
-      let* () = dev_tool |> Lock_dev_tool.lock_dev_tool |> Action_builder.of_memo in
+      let* () =
+        Lock_dev_tool.lock_dev_tool dev_tool network_cap |> Action_builder.of_memo
+      in
       (* Make sure the tool's lockdir is generated before building the tool. *)
       Action_builder.path (dev_tool_exe_path dev_tool))
   in
@@ -47,16 +49,16 @@ let build_dev_tool_via_rpc builder lock_held_by dev_tool =
   >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:false
 ;;
 
-let lock_and_build_dev_tool ~common ~config builder dev_tool =
+let lock_and_build_dev_tool ~common ~config builder dev_tool network_cap =
   let open Fiber.O in
   match Dune_util.Global_lock.lock ~timeout:None with
   | Error lock_held_by ->
     Scheduler.go_without_rpc_server ~common ~config (fun () ->
-      let* () = Lock_dev_tool.lock_dev_tool dev_tool |> Memo.run in
+      let* () = Lock_dev_tool.lock_dev_tool dev_tool network_cap |> Memo.run in
       build_dev_tool_via_rpc builder lock_held_by dev_tool)
   | Ok () ->
     Scheduler.go_with_rpc_server ~common ~config (fun () ->
-      build_dev_tool_directly common dev_tool)
+      build_dev_tool_directly common dev_tool network_cap)
 ;;
 
 let run_dev_tool workspace_root dev_tool ~args =
@@ -71,8 +73,8 @@ let run_dev_tool workspace_root dev_tool ~args =
   restore_cwd_and_execve workspace_root exe_path_string args env
 ;;
 
-let lock_build_and_run_dev_tool ~common ~config builder dev_tool ~args =
-  lock_and_build_dev_tool ~common ~config builder dev_tool;
+let lock_build_and_run_dev_tool ~common ~config builder dev_tool ~args network_cap =
+  lock_and_build_dev_tool ~common ~config builder dev_tool network_cap;
   run_dev_tool (Common.root common) dev_tool ~args
 ;;
 
@@ -113,10 +115,18 @@ let which_command dev_tool =
 
 let install_command dev_tool =
   let exe_name = Pkg_dev_tool.exe_name dev_tool in
+  let network_cap =
+    Dune_pkg.Network_cap.create
+      ~reason_for_network_access:
+        (sprintf
+           "Fetching package metadata to solve dependencies and downloading dependencies \
+            of %s."
+           exe_name)
+  in
   let term =
     let+ builder = Common.Builder.term in
     let common, config = Common.init builder in
-    lock_and_build_dev_tool ~common ~config builder dev_tool
+    lock_and_build_dev_tool ~common ~config builder dev_tool network_cap
   in
   let info =
     let doc = sprintf "Install %s as a dev tool" exe_name in
@@ -127,12 +137,20 @@ let install_command dev_tool =
 
 let exec_command dev_tool =
   let exe_name = Pkg_dev_tool.exe_name dev_tool in
+  let network_cap =
+    Dune_pkg.Network_cap.create
+      ~reason_for_network_access:
+        (sprintf
+           "Fetching package metadata to solve dependencies and downloading dependencies \
+            of %s."
+           exe_name)
+  in
   let term =
     let+ builder = Common.Builder.term
     (* CR-someday Alizter: document this option *)
     and+ args = Arg.(value & pos_all string [] (info [] ~docv:"ARGS" ~doc:None)) in
     let common, config = Common.init builder in
-    lock_build_and_run_dev_tool ~common ~config builder dev_tool ~args
+    lock_build_and_run_dev_tool ~common ~config builder dev_tool ~args network_cap
   in
   let info =
     let doc =