├── .devcontainer └── devcontainer.json ├── .dockerignore ├── .github └── workflows │ └── main.yml ├── .gitignore ├── .gitmodules ├── .vscode └── settings.json ├── Dockerfile ├── Makefile ├── README.md ├── client ├── dune └── main.ml ├── compare ├── dune ├── errors.ml ├── parsing.ml ├── parsing_par.ml └── perf.ml ├── doc ├── intro.md ├── multicore.md ├── porting.md └── prereqs.md ├── dune ├── dune-project ├── server ├── context.ml ├── context.mli ├── dune ├── log.ml ├── main.ml ├── packages.ml ├── packages.mli └── solver.ml ├── solutions ├── 2-lwt-eio │ ├── context.ml │ ├── context.mli │ ├── dune │ ├── log.ml │ ├── main.ml │ ├── packages.ml │ ├── packages.mli │ └── solver.ml ├── 3-eio │ ├── context.ml │ ├── context.mli │ ├── dune │ ├── log.ml │ ├── main.ml │ ├── packages.ml │ ├── packages.mli │ └── solver.ml └── 4-eio-multicore │ ├── context.ml │ ├── context.mli │ ├── dune │ ├── log.ml │ ├── main.ml │ ├── opam_lock.ml │ ├── packages.ml │ ├── packages.mli │ ├── solver.ml │ └── worker_pool.ml └── tutorial.opam /.devcontainer/devcontainer.json: -------------------------------------------------------------------------------- 1 | // For format details, see https://aka.ms/devcontainer.json. For config options, see the 2 | // README at: https://github.com/devcontainers/templates/tree/main/src/debian 3 | { 4 | "name": "Debian", 5 | // Or use a Dockerfile or Docker Compose file. More info: https://containers.dev/guide/dockerfile 6 | 7 | // Use 'forwardPorts' to make a list of ports inside the container available locally. 8 | // "forwardPorts": [], 9 | 10 | "build":{ "dockerfile": "../Dockerfile" }, 11 | 12 | "containerUser": "opam", 13 | 14 | "postCreateCommand": "sudo sysctl -w kernel.perf_event_paranoid=-1 kernel.kptr_restrict=0", 15 | 16 | // Configure tool-specific properties. 17 | // "customizations": {}, 18 | 19 | // Uncomment to connect as root instead. More info: https://aka.ms/dev-containers-non-root. 20 | // "remoteUser": "root" 21 | 22 | "customizations": { 23 | "vscode": { 24 | "extensions": [ 25 | "ocamllabs.ocaml-platform", 26 | "docker" 27 | ] 28 | } 29 | }, 30 | 31 | "runArgs": ["--privileged", "--platform=linux/amd64" ] 32 | } 33 | -------------------------------------------------------------------------------- /.dockerignore: -------------------------------------------------------------------------------- 1 | **/.git 2 | _build 3 | opam-repository 4 | -------------------------------------------------------------------------------- /.github/workflows/main.yml: -------------------------------------------------------------------------------- 1 | name: Main workflow 2 | 3 | on: 4 | pull_request: 5 | push: 6 | 7 | jobs: 8 | docker: 9 | runs-on: ubuntu-latest 10 | steps: 11 | - uses: actions/checkout@v2 12 | with: 13 | submodules: recursive 14 | - name: Build the Docker image 15 | run: docker build . 16 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build 2 | perf.data 3 | perf.data.old 4 | -------------------------------------------------------------------------------- /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "vendor/eio"] 2 | path = vendor/eio 3 | url = https://github.com/talex5/eio.git 4 | branch = hack 5 | [submodule "vendor/lwt_eio"] 6 | path = vendor/lwt_eio 7 | url = https://github.com/talex5/lwt_eio.git 8 | branch = eio-0.12-types 9 | [submodule "vendor/ocaml-git"] 10 | path = vendor/ocaml-git 11 | url = https://github.com/talex5/ocaml-git.git 12 | branch = eio-minimal 13 | [submodule "vendor/opam-0install-solver"] 14 | path = vendor/opam-0install-solver 15 | url = https://github.com/talex5/opam-0install-solver.git 16 | branch = atomic-ids 17 | [submodule "vendor/ocaml-cohttp"] 18 | path = vendor/ocaml-cohttp 19 | url = https://github.com/talex5/ocaml-cohttp.git 20 | branch = eio 21 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "ocaml.sandbox": { 3 | "kind": "opam", 4 | "switch": "5.1.0~rc1+fp" 5 | } 6 | } -------------------------------------------------------------------------------- /Dockerfile: -------------------------------------------------------------------------------- 1 | FROM --platform=linux/amd64 ocaml/opam:debian-12-opam as base 2 | RUN sudo ln -sf /usr/bin/opam-2.1 /usr/bin/opam 3 | ENV OPAMYES="1" OPAMCONFIRMLEVEL="unsafe-yes" OPAMERRLOGLEN="0" OPAMPRECISETRACKING="1" 4 | RUN cd ~/opam-repository && git fetch origin master && git reset --hard d8b94b939664f77f072b506a5b75f87b33e32abd && opam update 5 | WORKDIR src 6 | RUN sudo apt install -y libunwind-dev linux-perf 7 | 8 | # 9 | # To try tsan, uncomment the following block and ALSO the block below 10 | # Note that at time writing this doesn't work on M1/M2 macs 11 | # 12 | #FROM base as tsan 13 | #RUN opam switch create 5.1.0+tsan 14 | #COPY vendor/ocaml-git/*.opam vendor/ocaml-git/ 15 | #RUN opam pin -yn --with-version=3.13.0 vendor/ocaml-git 16 | #COPY tutorial.opam . 17 | #RUN opam install --deps-only -t . 18 | 19 | FROM base as ocaml510fp 20 | RUN opam switch create 5.1.0+fp ocaml-variants.5.1.0+options ocaml-option-fp 21 | COPY vendor/ocaml-git/*.opam vendor/ocaml-git/ 22 | RUN opam pin -yn --with-version=3.13.0 vendor/ocaml-git 23 | COPY tutorial.opam . 24 | RUN opam install --switch=5.1.0+fp --deps-only -t . 25 | 26 | # 27 | # Also uncomment this block to try tsan 28 | # 29 | #COPY --from=tsan /home/opam/.opam/5.1.0+tsan /home/opam/.opam/5.1.0+tsan 30 | #RUN sed -i 's/installed-switches: "5.1.0+fp"/installed-switches: ["5.1.0+fp" "5.1.0+tsan"]/' ../.opam/config 31 | 32 | RUN opam install ocaml-lsp-server ocamlformat 33 | ENTRYPOINT [ "opam", "exec", "--" ] 34 | CMD bash 35 | 36 | COPY . . 37 | 38 | RUN opam exec -- make 39 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune build 3 | 4 | test: 5 | dune exec -- ./client/main.exe 6 | 7 | deps: 8 | opam install --deps-only -t . 9 | 10 | docker-image: 11 | docker build -t icfp . 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Lwt to Eio tutorial 2 | 3 | This tutorial covers how to convert an OCaml 4 program using Lwt for concurrency to use OCaml 5 and Eio. 4 | 5 | 0. [Prerequisites](./doc/prereqs.md) -- things to install before starting 6 | 1. [Eio introduction and Lwt comparison](./doc/intro.md) 7 | 2. [Porting from Lwt to Eio](./doc/porting.md) 8 | 3. [Using multiple cores](./doc/multicore.md) 9 | -------------------------------------------------------------------------------- /client/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries eio_main cohttp-eio)) 4 | -------------------------------------------------------------------------------- /client/main.ml: -------------------------------------------------------------------------------- 1 | (* A simple HTTP client to test the server. It sends 3 solver requests concurrently. *) 2 | 3 | open Eio.Std 4 | 5 | let solve_url ~commit ~ocaml_version pkg = 6 | Uri.of_string (Printf.sprintf "http://127.0.0.1:8080/solve/%s/%s?ocaml_version=%s" commit pkg ocaml_version) 7 | 8 | let solve http ~ocaml_version ~commit pkg = 9 | Switch.run @@ fun sw -> 10 | let uri = solve_url ~commit ~ocaml_version pkg in 11 | traceln "Requesting %a" Uri.pp uri; 12 | let resp, body = Cohttp_eio.Client.get ~sw http uri in 13 | if resp.status = `OK then ( 14 | Eio.Buf_read.(parse_exn take_all) body ~max_size:max_int 15 | ) else ( 16 | Fmt.failwith "Error from server: %s" (Cohttp.Code.string_of_status resp.status) 17 | ) 18 | 19 | let commit = "9faf3dbf816f376733b73f3ed8832c4213db4a02" 20 | let requests = 21 | ["4.02.0", "lwt"; 22 | "4.14.0", "lwt"; 23 | "5.0.0", "lwt"] 24 | 25 | let () = 26 | Eio_main.run @@ fun env -> 27 | let http = Cohttp_eio.Client.make env#net in 28 | let t0 = Unix.gettimeofday () in 29 | requests |> Fiber.List.iter (fun (ocaml_version, package) -> 30 | let solution = solve http ~commit ~ocaml_version package in 31 | traceln "%s : %s" ocaml_version solution 32 | ); 33 | let t1 = Unix.gettimeofday () in 34 | traceln "Finished in %.2f s" (t1 -. t0) 35 | -------------------------------------------------------------------------------- /compare/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names errors perf parsing parsing_par) 3 | (libraries eio_main lwt.unix)) 4 | -------------------------------------------------------------------------------- /compare/errors.ml: -------------------------------------------------------------------------------- 1 | (* This example runs two tasks concurrently: 2 | 3 | - "task1" waits for a network connection. 4 | - "task2" raises an exception. 5 | 6 | Eio cancels task1 and reports the exception immediately. 7 | Lwt waits for a connection before reporting the error. 8 | 9 | Also, the backtrace from Eio is more useful; we can see that [simulated_error] was 10 | called from [task2]: 11 | 12 | Exception: Not_found 13 | Raised at Dune__exe__Errors.Example_eio.simulated_error in file "compare/errors.ml", line 25, characters 6-21 14 | Called from Dune__exe__Errors.Example_eio.run_task2 in file "compare/errors.ml", line 31, characters 4-22 15 | 16 | Lwt instead shows [simulated_error] being called from the Lwt engine: 17 | 18 | Exception: Not_found 19 | Raised at Dune__exe__Errors.Example_lwt.simulated_error.(fun) in file "compare/errors.ml", line 58, characters 6-21 20 | Called from Lwt.Sequential_composition.bind.create_result_promise_and_callback_if_deferred.callback in file "src/core/lwt.ml", line 1829, characters 23-26 21 | Re-raised at Lwt.Miscellaneous.poll in file "src/core/lwt.ml", line 3059, characters 20-29 22 | 23 | Also, Eio closes both FDs, even in the cancelled path. 24 | *) 25 | 26 | let () = Printexc.record_backtrace true 27 | 28 | let simulate_error = true 29 | 30 | module Example_eio = struct 31 | open Eio.Std 32 | 33 | let run_task1 net = 34 | traceln "Running task1 (wait for connection on port 8081)..."; 35 | Switch.run @@ fun sw -> 36 | let socket = Eio.Net.listen ~sw ~backlog:5 net (`Tcp (Eio.Net.Ipaddr.V4.loopback, 8081)) in 37 | let conn, _addr = Eio.Net.accept ~sw socket in 38 | Eio.Net.close conn; 39 | traceln "Task1 done" 40 | 41 | let simulated_error () = 42 | Fiber.yield (); 43 | if simulate_error then ( 44 | traceln "Raising exception..."; 45 | raise Not_found 46 | ) 47 | 48 | let run_task2 () = 49 | traceln "Running task2..."; 50 | simulated_error (); 51 | traceln "Task2 done" 52 | 53 | let run () = 54 | Eio_main.run @@ fun env -> 55 | Fiber.both 56 | (fun () -> run_task1 env#net) 57 | (fun () -> run_task2 ()) 58 | end 59 | 60 | module Example_lwt = struct 61 | open Lwt.Syntax 62 | 63 | let run_task1 () = 64 | print_endline "Running task1 (wait for connection on port 8082)..."; 65 | let socket = Lwt_unix.(socket PF_INET SOCK_STREAM 0) in 66 | Lwt_unix.setsockopt socket SO_REUSEADDR true; 67 | let* () = Lwt_unix.bind socket (Unix.ADDR_INET (Unix.inet_addr_any, 8082)) in 68 | Lwt_unix.listen socket 5; 69 | let* conn, _addr = Lwt_unix.accept socket in 70 | let* () = Lwt_unix.close conn in 71 | print_endline "Task1 done"; 72 | Lwt.return_unit 73 | 74 | let simulated_error () = 75 | let* () = Lwt.pause () in 76 | if simulate_error then ( 77 | print_endline "Raising exception... (won't appear until you connect to port 8082)"; 78 | raise Not_found 79 | ) else Lwt.return_unit 80 | 81 | let run_task2 () = 82 | print_endline "Running task2..."; 83 | let* () = simulated_error () in 84 | print_endline "Task2 done"; 85 | Lwt.return_unit 86 | 87 | let run () = 88 | Lwt_main.run begin 89 | Lwt.join [ 90 | run_task1 (); 91 | run_task2 (); 92 | ] 93 | end 94 | end 95 | 96 | let test fn = 97 | try fn () 98 | with ex -> 99 | let bt = Printexc.get_raw_backtrace () in 100 | Fmt.epr "Example finished with exception:@.%a@." Fmt.exn_backtrace (ex, bt) 101 | 102 | let () = 103 | Fmt.pr "Running Eio example...@."; 104 | test Example_eio.run; 105 | Fmt.pr "@.Running Lwt example...@."; 106 | test Example_lwt.run 107 | -------------------------------------------------------------------------------- /compare/parsing.ml: -------------------------------------------------------------------------------- 1 | (* Parse a load of data from /dev/zero, one character at a time. 2 | 3 | This is much faster with Eio, as Lwt pays the cost of possibly 4 | having to suspend for every byte, even though the data is usually 5 | buffered. 6 | 7 | Note: This isn't a very realistic workload and typically the 8 | difference between Lwt and Eio will be smaller. 9 | *) 10 | 11 | let n_bytes = 100_000_000 12 | 13 | let buffer_size = 4096 (* Ensure Lwt and Eio are using the same size buffer *) 14 | 15 | let time label fn = 16 | let t0 = Unix.gettimeofday () in 17 | fn (); 18 | let t1 = Unix.gettimeofday () in 19 | Fmt.pr "%s took %.2f s@." label (t1 -. t0) 20 | 21 | module Example_eio = struct 22 | let parse r = 23 | for _ = 1 to n_bytes do 24 | let r = Eio.Buf_read.any_char r in 25 | ignore (r : char) 26 | (* assert (r = '\x00') *) 27 | done 28 | 29 | let run () = 30 | let ( / ) = Eio.Path.( / ) in 31 | Eio_main.run @@ fun env -> 32 | Eio.Path.with_open_in (env#fs / "/dev/zero") @@ fun zero -> 33 | parse (Eio.Buf_read.of_flow zero ~initial_size:buffer_size ~max_size:buffer_size) 34 | end 35 | 36 | module Example_lwt = struct 37 | open Lwt.Syntax 38 | 39 | let parse stream = 40 | let rec aux = function 41 | | 0 -> Lwt.return_unit 42 | | i -> 43 | let* r = Lwt_io.read_char stream in 44 | ignore (r : char); 45 | (* assert (r = '\x00'); *) 46 | aux (i - 1) 47 | in 48 | aux n_bytes 49 | 50 | let run () = 51 | Lwt_main.run begin 52 | let buffer = Lwt_bytes.create buffer_size in 53 | Lwt_io.(with_file ~buffer ~mode:input) "/dev/zero" @@ fun zero -> 54 | parse zero 55 | end 56 | end 57 | 58 | let () = 59 | time "Eio" Example_eio.run; 60 | time "Lwt" Example_lwt.run; 61 | time "Eio" Example_eio.run; 62 | time "Lwt" Example_lwt.run 63 | -------------------------------------------------------------------------------- /compare/parsing_par.ml: -------------------------------------------------------------------------------- 1 | (* Like "parsing.ml", but doing parallel reads. *) 2 | 3 | let n_bytes = 100_000_000 4 | let n_parallel = 4 5 | 6 | let time label fn = 7 | let t0 = Unix.gettimeofday () in 8 | fn (); 9 | let t1 = Unix.gettimeofday () in 10 | Fmt.pr "%s took %.2f s@." label (t1 -. t0) 11 | 12 | module Example_eio = struct 13 | open Eio.Std 14 | 15 | let parse r = 16 | for _ = 1 to n_bytes do 17 | let r = Eio.Buf_read.any_char r in 18 | ignore (r : char) 19 | done 20 | 21 | let par_do domain_mgr n fn = 22 | Switch.run @@ fun sw -> 23 | for _ = 1 to n - 1 do 24 | Fiber.fork ~sw (fun () -> Eio.Domain_manager.run domain_mgr fn) 25 | done; 26 | fn () (* Use the original domain for the last one *) 27 | 28 | let run () = 29 | let ( / ) = Eio.Path.( / ) in 30 | Eio_main.run @@ fun env -> 31 | par_do env#domain_mgr n_parallel @@ fun () -> 32 | Eio.Path.with_open_in (env#fs / "/dev/zero") @@ fun zero -> 33 | parse (Eio.Buf_read.of_flow ~max_size:max_int zero) 34 | end 35 | 36 | module Example_lwt = struct 37 | open Lwt.Syntax 38 | 39 | let parse stream = 40 | let rec aux = function 41 | | 0 -> Lwt.return_unit 42 | | i -> 43 | let* r = Lwt_io.read_char stream in 44 | ignore (r : char); 45 | aux (i - 1) 46 | in 47 | aux n_bytes 48 | 49 | let run () = 50 | Lwt_main.run begin 51 | Lwt.join @@ List.init n_parallel (fun _ -> Lwt_io.(with_file ~mode:input) "/dev/zero" parse) 52 | end 53 | end 54 | 55 | let () = 56 | time "Eio" Example_eio.run; 57 | time "Lwt" Example_lwt.run; 58 | time "Eio" Example_eio.run; 59 | time "Lwt" Example_lwt.run 60 | -------------------------------------------------------------------------------- /compare/perf.ml: -------------------------------------------------------------------------------- 1 | [@@@warning "-A"] 2 | (* Two threads use a lot of CPU time in a loop. 3 | 4 | Profiling using e.g. "perf record --call-graph=dwarf" gives more useful results for Eio, 5 | since the stack includes which task was running. 6 | *) 7 | 8 | let outer_iters = 2_000 9 | let inner_iters = 2_000 10 | 11 | let use_cpu () = 12 | for _ = 1 to inner_iters do 13 | ignore @@ Sys.opaque_identity @@ Digest.string "Hello!" 14 | done 15 | 16 | module Example_eio = struct 17 | open Eio.Std 18 | 19 | let do_work () = 20 | Fiber.yield (); 21 | use_cpu () 22 | [@@inline never] 23 | 24 | let run_task1 () = 25 | for _ = 1 to outer_iters do do_work () done 26 | 27 | let run_task2 () = 28 | for _ = 1 to outer_iters do do_work () done 29 | 30 | let run () = 31 | Eio_main.run @@ fun _ -> 32 | Fiber.both run_task1 run_task2 33 | end 34 | 35 | module Example_lwt = struct 36 | open Lwt.Syntax 37 | 38 | let do_work () = 39 | let* () = Lwt.pause () in 40 | use_cpu (); 41 | Lwt.return_unit 42 | [@@inline never] 43 | 44 | let run_task1 () = 45 | let rec outer = function 46 | | 0 -> Lwt.return_unit 47 | | i -> 48 | let* () = do_work () in 49 | outer (i - 1) 50 | in 51 | outer outer_iters 52 | 53 | let run_task2 () = 54 | let rec outer = function 55 | | 0 -> Lwt.return_unit 56 | | i -> 57 | let* () = do_work () in 58 | outer (i - 1) 59 | in 60 | outer outer_iters 61 | 62 | let run () = 63 | Lwt_main.run begin 64 | Lwt.join [ 65 | run_task1 (); 66 | run_task2 (); 67 | ] 68 | end 69 | end 70 | 71 | let time label fn = 72 | let t0 = Unix.gettimeofday () in 73 | fn (); 74 | let t1 = Unix.gettimeofday () in 75 | Fmt.pr "%s took %.2f s@." label (t1 -. t0) 76 | 77 | let () = 78 | time "Eio" Example_eio.run; 79 | time "Lwt" Example_lwt.run; 80 | time "Eio" Example_eio.run; 81 | time "Lwt" Example_lwt.run 82 | -------------------------------------------------------------------------------- /doc/intro.md: -------------------------------------------------------------------------------- 1 | ## Introduction to Eio 2 | 3 | The [Eio README](https://github.com/ocaml-multicore/eio) covers most of the main features of Eio, 4 | so you might want to read a bit of that first if you haven't used Eio at all. 5 | 6 | Here, we'll look at a few differences between Lwt and Eio. 7 | 8 | ### Direct-style vs monadic code 9 | 10 | Eio allows use of direct-style code, which is shorter, easier for beginners, 11 | runs faster, and interoperates with non-Lwt code: 12 | 13 | ```diff 14 | - foo () >>= fun x -> 15 | + let x = foo () in 16 | ``` 17 | 18 | ```diff 19 | - Lwt.catch 20 | - (fun () -> ...) 21 | - (function 22 | - | E -> ... 23 | - | ex -> Lwt.fail ex) 24 | + try 25 | + ... 26 | + with E -> ... 27 | ``` 28 | 29 | ```diff 30 | - Lwt.try_bind 31 | - (fun () -> ...) 32 | - (fun v -> ...) 33 | - (function 34 | - | E -> ... 35 | - | ex -> Lwt.fail ex) 36 | + match ... with 37 | + | v -> ... 38 | + | exception E -> ... 39 | ``` 40 | 41 | ```diff 42 | - let rec aux i = 43 | - if i <= 1000 then (...; aux (i + 1)) 44 | - in aux 1 45 | + for i = 1 to 1000 do ... done 46 | ``` 47 | 48 | ```diff 49 | - Lwt_list.iter_s f xs 50 | + List.iter f xs 51 | ``` 52 | 53 | ### Performance 54 | 55 | The `compare/parsing.ml` example opens `/dev/zero` and reads a load of data from it, one character at a time. 56 | Eio is much faster, even though it's still only using one core: 57 | 58 | ``` 59 | $ dune exec -- ./compare/parsing.exe 60 | Eio took 0.35 s 61 | Lwt took 1.46 s 62 | Eio took 0.35 s 63 | Lwt took 1.47 s 64 | ``` 65 | 66 | The reason is that Lwt always has to allocate a callback on the heap 67 | in case `Lwt_io.read_char` needs to suspend and wait for the OS, 68 | even though the data is usually buffered. 69 | 70 | With Eio, we can also use multiple domains for more performance. 71 | `parsing_par` does the test 4 times in parallel: 72 | 73 | ``` 74 | $ dune exec -- ./compare/parsing_par.exe 75 | Eio took 0.40 s 76 | Lwt took 5.16 s 77 | Eio took 0.40 s 78 | Lwt took 5.20 s 79 | ``` 80 | 81 | ### Performance monitoring 82 | 83 | The `compare/perf.ml` example runs Eio and Lwt examples, 84 | each running two threads doing the same amount of CPU work. 85 | Using a `+fp` version of the compiler (to get frame pointers), 86 | we can use `perf record -g` to profile it: 87 | 88 | ``` 89 | dune build -- ./compare/perf.exe && perf record -g ./_build/default/compare/perf.exe 90 | ``` 91 | 92 | Note: if using Docker, you'll need to run with `--privileged` to avoid getting `Operation not permitted`. 93 | 94 | The results show that we spent 50% of the time doing work in Lwt, but we've lost the task1/task2 distinction. 95 | As before, the stack-trace only records that a leaf function was resumed by Lwt. 96 | The Eio part of the results show the two tasks taking 25% of the time each: 97 | 98 | ``` 99 | perf report -g 100 | - caml_start_program 101 | - 99.89% caml_startup.code_begin 102 | - 99.89% Dune.exe.Perf.entry 103 | - Dune.exe.Perf.time_560 104 | - 49.94% Lwt_main.run_495 105 | - Lwt_main.run_loop_435 106 | - 49.83% Lwt_sequence.loop_346 107 | - Lwt.wakeup_general_1071 108 | Lwt.resolve_1034 109 | Lwt.run_in_resolution_loop_1014 110 | Lwt.iter_callback_list_944 111 | - Lwt.callback_1373 112 | - 49.77% Dune.exe.Perf.fun_967 113 | + 49.77% Dune.exe.Perf.use_cpu_273 114 | - 49.90% Eio_linux.Sched.with_sched_inner_3088 115 | - 49.89% Eio_linux.Sched.with_eventfd_1738 116 | Eio_linux.Sched.run_1519 117 | - Stdlib.Fun.protect_320 118 | - 49.86% caml_runstack 119 | Stdlib.Fun.protect_320 120 | - Eio.core.Fiber.fun_1369 121 | - 25.07% Dune.exe.Perf.run_task2_425 122 | + Dune.exe.Perf.use_cpu_273 123 | - 24.78% Dune.exe.Perf.run_task1_421 124 | + 24.77% Dune.exe.Perf.use_cpu_273 125 | ``` 126 | 127 | ### Error handling 128 | 129 | The `compare/errors.ml` file demonstrates an important difference in Eio's error handling. 130 | The example runs two tasks concurrently: 131 | 132 | - `task1` waits for a network connection. 133 | - `task2` raises an exception. 134 | 135 | When `task2` fails, Eio automatically cancels `task1` and reports the exception immediately. 136 | Lwt instead waits for `task1` to finish (which might never happen) before reporting the error. 137 | This often causes Lwt applications to fail with no visible error. 138 | 139 | Backtraces from Eio are also often more useful. 140 | We can see here that `simulated_error` was called from `task2`: 141 | 142 | ``` 143 | Exception: Not_found 144 | Raised at Dune__exe__Errors.Example_eio.simulated_error in file "compare/errors.ml", line 25, characters 6-21 145 | Called from Dune__exe__Errors.Example_eio.run_task2 in file "compare/errors.ml", line 31, characters 4-22 146 | ``` 147 | 148 | Lwt instead only shows that `simulated_error` was resumed by the Lwt engine: 149 | 150 | ``` 151 | Exception: Not_found 152 | Raised at Dune__exe__Errors.Example_lwt.simulated_error.(fun) in file "compare/errors.ml", line 58, characters 6-21 153 | Called from Lwt.Sequential_composition.bind.create_result_promise_and_callback_if_deferred.callback in file "src/core/lwt.ml", line 1829, characters 23-26 154 | Re-raised at Lwt.Miscellaneous.poll in file "src/core/lwt.ml", line 3059, characters 20-29 155 | ``` 156 | 157 | Note that the Lwt example requires a `Lwt.pause` (simulating some IO) to show these problems. 158 | If you remove that, then the stack trace is helpful and it doesn't wait for the server thread 159 | (which is still listening even after `Lwt_main.run` returns). 160 | Lwt code often behaves differently depending on whether it did IO or not. 161 | By contrast, the Eio code behaves the same way if you remove the `Fiber.yield`. 162 | 163 | ### Resource leaks 164 | 165 | Eio requires all resources to be attached to a *switch*, which ensures they are released when the switch finishes. 166 | 167 | Lwt code often accidentally leaks resources, especially on error paths. 168 | In the `errors.ml` example above, if you did cancel `run_task1` (e.g. with `Lwt.cancel`) then it would fail to close `conn`. 169 | And it forgets to close `socket` whether you cancel it or not! 170 | 171 | The Eio version ensures that both the listening socket and the connected socket are closed, 172 | whether it completes successfully or fails. 173 | 174 | ### Bounds on behaviour 175 | 176 | Usually the first thing we want to know about a program is what effect it will have on the outside world. 177 | With Lwt, this is difficult. A Lwt program typically starts like this: 178 | 179 | ```ocaml 180 | Lwt_main.run (main ()) 181 | ``` 182 | 183 | Looking at this, we have no idea what this program might do. 184 | We could read the `main` function, but that will call other functions, which call yet more functions. 185 | Without reading all the code of every library being used (typically 100s of thousands of lines), 186 | we can't answer even basic questions such as "will this program write to my `~/.ssh` directory?". 187 | 188 | This is because Lwt treats OS resources such as the file-system and the network like global variables, 189 | accessible from anywhere. 190 | It's hard to reason about global variables, because any code can access them. 191 | 192 | Eio instead provides access to the outside world as a function argument, usually named `env`. 193 | By looking at what happens to the `env` argument, we can quickly get a bound on the program's behaviour. 194 | For example: 195 | 196 | ```ocaml 197 | let () = 198 | Eio_main.run @@ fun env -> 199 | Switch.run @@ fun sw -> 200 | let addr = `Tcp (Eio.Net.Ipaddr.V4.any, 8080) in 201 | let socket = Eio.Net.listen ~sw ~backlog:5 ~reuse_addr:true env#net addr in 202 | Eio.Path.with_open_dir (env#cwd / "opam-repository") @@ fun opam_repo -> 203 | main ~socket opam_repo 204 | ``` 205 | 206 | Placing the cursor on `env`, our text editor highlights the two uses: 207 | this program uses the network and the current directory. 208 | More specifically: 209 | 210 | - It uses the network directly only once, to create a listening socket on port 8080. 211 | - It uses the cwd only once, to get access to `~/opam-repository`. 212 | 213 | If we wanted to know exactly how it uses the socket or the directory 214 | we would check what `main` does with them, but we already have a useful bound on the behaviour. 215 | For example, we now have enough information to know what firewall rules this program 216 | requires. 217 | 218 | For more details, see [Lambda Capabilities][]. 219 | 220 | [Lambda Capabilities]: https://roscidus.com/blog/blog/2023/04/26/lambda-capabilities/ 221 | 222 | ### Monitoring 223 | 224 | OCaml 5.1 allows programs to output custom events and this provides lots of 225 | useful information about what an Eio program is doing. 226 | 227 | See [Meio][] for a preview of this feature. 228 | To try it, you'll need to apply [Eio PR#554](https://github.com/ocaml-multicore/eio/pull/554). 229 | 230 | **Update**: You can now use [eio-trace][] instead. 231 | 232 | [Meio]: https://github.com/ocaml-multicore/meio 233 | [eio-trace]: https://github.com/ocaml-multicore/eio-trace 234 | 235 | ## Next 236 | 237 | [Porting from Lwt to Eio](./porting.md) 238 | -------------------------------------------------------------------------------- /doc/multicore.md: -------------------------------------------------------------------------------- 1 | # Using multiple cores 2 | 3 | So far, the solver server only uses one core. 4 | We'll now use multiple CPU cores to improve performance. 5 | 6 | ## Thread-safe logging 7 | 8 | Before we start, note that the `Logs` library is not thread-safe by default. 9 | Add a call to `Logs_threaded.enable ()` (using the `logs.threaded` library), 10 | or you'll get errors like this: 11 | 12 | ``` 13 | main.exe: [INFO] tcp:127.0.0.1:41676: accept connection 14 | main.exemain.exeINFO 15 | main.exe: [main.exe: [INFOain.exe: [WARNING] Exception: Stdlib.Queue.Empty 16 | Raised at Stdlib__Queue.take in file "queue.ml", line 73, characters 11-22 17 | Called from Stdlib__Format.advance_left in file "format.ml", line 436, characters 6-31 18 | ``` 19 | 20 | ## Using multiple domains with cohttp 21 | 22 | There are a couple of ways we can use multiple cores in this example. 23 | One option is to ask cohttp to run multiple accept loops. 24 | For example, this uses 4 domains (in total): 25 | 26 | ```ocaml 27 | let main ~domain_mgr ~socket opam_repo = 28 | ... 29 | Server.run ~additional_domains:(domain_mgr, 3) ... 30 | ``` 31 | 32 | (get `domain_mgr` using `env#domain_mgr`) 33 | 34 | However, we don't have a performance problem handling HTTP requests, 35 | and doing this means having to make the entire connection handler thread-safe. 36 | For example, the solver caches the packages for the last commit: 37 | 38 | ```ocaml 39 | let packages t commit = 40 | match t.packages_cache with 41 | | Some (c, p) when Git_unix.Store.Hash.equal c commit -> Eio.Lazy.force p 42 | | _ -> 43 | let p = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> 44 | Log.info (fun f -> f "Loading packages..."); 45 | let pkgs = Packages.of_commit t.store commit in 46 | Log.info (fun f -> f "Loaded packages"); 47 | pkgs 48 | ) in 49 | t.packages_cache <- Some (commit, p); 50 | Eio.Lazy.force p 51 | ``` 52 | 53 | This code relies on the fact that once we've seen that the commit we want isn't cached, 54 | we can set `packages_cache` to a lazy value that will compute it atomically. 55 | 56 | We could fix that by adding a mutex around this code. 57 | In this case we could use a plain `Stdlib.Mutex`, 58 | since we won't be switching fibers between checking the cache and putting the lazy value in it, 59 | but it's safest to use `Eio.Mutex` anyway, 60 | which handles that (by having the fiber wait for the lock, rather than raising an exception). 61 | 62 | ## Using a worker pool for solves 63 | 64 | Alternatively, we can have just one domain handling HTTP requests and use a pool of workers for solving. 65 | This minimises the amount of code we need to make thread-safe. 66 | 67 | Here is a simple `worker_pool.ml` module: 68 | 69 | ```ocaml 70 | open Eio.Std 71 | 72 | type job = Job : (unit -> 'a) * ('a, exn) result Promise.u -> job 73 | 74 | type t = job Eio.Stream.t 75 | 76 | let submit (t:t) fn = 77 | let p, r = Promise.create () in 78 | Eio.Stream.add t (Job (fn, r)); 79 | Promise.await_exn p 80 | 81 | let rec run_worker (t:t) = 82 | let Job (fn, reply) = Eio.Stream.take t in 83 | let id = (Domain.self () :> int) in 84 | traceln "Domain %d: running job..." id; 85 | begin 86 | match fn () with 87 | | v -> Promise.resolve_ok reply v 88 | | exception ex -> Promise.resolve_error reply ex 89 | end; 90 | traceln "Domain %d: finished" id; 91 | run_worker t 92 | 93 | let create ~sw ~domain_mgr n : t = 94 | let t = Eio.Stream.create 0 in 95 | for _ = 1 to n do 96 | Fiber.fork_daemon ~sw (fun () -> Eio.Domain_manager.run domain_mgr (fun () -> run_worker t)) 97 | done; 98 | t 99 | ``` 100 | 101 | Each new domain runs a worker that accepts jobs from the stream. 102 | Each job is a function run in the worker's domain and a resolver for the reply. 103 | 104 | We start a pool of workers running at the start: 105 | ```ocaml 106 | let pool = Worker_pool.create ~sw ~domain_mgr:env#domain_mgr 3 in 107 | ``` 108 | and use it in `solver.ml`'s `solve` function to call the 0install solver: 109 | ```ocaml 110 | Worker_pool.submit t.pool @@ fun () -> 111 | match Solver.solve ctx [pkg] with 112 | ``` 113 | 114 | ## Testing 115 | 116 | Whichever way you added support for multiple domains, you may find that it now crashes sometimes: 117 | 118 | ``` 119 | solver service: internal error, uncaught exception: 120 | Multiple exceptions: 121 | - Failure("Error parsing async.108.00.01: At ./:2:0-2:10::\nParse error") 122 | Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 123 | Called from Dune__exe__Packages.read_versions.(fun) in file "solutions/4-eio-multicore/packages.ml", line 44, charact 124 | ... 125 | - Failure("Error parsing mirage.0.10.0: At ./:1:12-1:13::\nParse error") 126 | Raised at Stdlib.failwith in file "stdlib.ml", line 29, characters 17-33 127 | Called from Dune__exe__Packages.read_versions.(fun) in file "solutions/4-eio-multicore/packages.ml", line 44, charact 128 | ... 129 | ``` 130 | 131 | If you don't get an error, try modifying the client code (in `client/main.ml`) to request three different packages 132 | (e.g. `lwt`, `irmin` and `bap`). 133 | 134 | To find races (and their causes) more reliably, 135 | you can use [ocaml-tsan](https://github.com/ocaml-multicore/ocaml-tsan). 136 | 137 | ``` 138 | WARNING: ThreadSanitizer: data race (pid=145041) 139 | Read of size 8 at 0x7effe74adf78 by thread T4 (mutexes: write M85): 140 | #0 camlStdlib__Hashtbl.ongoing_traversal_280 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/hashtbl.ml:42 (main.exe+0x71f69b)htbl.iter_760 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/hashtbl.ml:162 (main.exe+0x720636)lCarton_git.get_1281 vendor/ocaml-git/src/carton-git/carton_git.ml:165 (main.exe+0x358bf6) 141 | #3 camlGit_eio__Store.read_inflated_4923 vendor/ocaml-git/src/git-eio/store.ml:190 (main.exe+0x31d5d8) 142 | #4 camlGit_eio__Store.read_opt_4953 vendor/ocaml-git/src/git-eio/store.ml:218 (main.exe+0x31dbd6) 143 | #5 camlGit_eio__Store.read_4997 vendor/ocaml-git/src/git-eio/store.ml:223 (main.exe+0x31dc9b) 144 | #6 camlDune__exe__Packages.read_dir_4776 solutions/4-eio-multicore/packages.ml:12 (main.exe+0x2df6d1) 145 | ... 146 | Previous write of size 8 at 0x7effe74adf78 by thread T1 (mutexes: write M81): 147 | #0 camlStdlib__Hashtbl.iter_760 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/hashtbl.ml:45 (main.exe+0x720665) 148 | #1 camlCarton_git.get_1281 vendor/ocaml-git/src/carton-git/carton_git.ml:165 (main.exe+0x358bf6) 149 | #2 camlGit_eio__Store.read_inflated_4923 vendor/ocaml-git/src/git-eio/store.ml:190 (main.exe+0x31d5d8) 150 | #3 camlGit_eio__Store.read_opt_4953 vendor/ocaml-git/src/git-eio/store.ml:218 (main.exe+0x31dbd6) 151 | #4 camlGit_eio__Store.read_4997 vendor/ocaml-git/src/git-eio/store.ml:223 (main.exe+0x31dc9b) 152 | #5 camlDune__exe__Packages.read_dir_4776 solutions/4-eio-multicore/packages.ml:12 (main.exe+0x2df6d1) 153 | ``` 154 | 155 | Even though ocaml-git is only being used in read-only mode, it still isn't thread safe. 156 | To fix that, we can put a mutex around it: 157 | 158 | ```ocaml 159 | module Store = struct 160 | module Store_unsafe = Git_eio.Store 161 | module Search_unsafe = Git_eio.Search.Make (Digestif.SHA1) (Store_unsafe) 162 | module Value = Store_unsafe.Value 163 | 164 | let lock = Mutex.create () 165 | let with_lock fn = 166 | Mutex.lock lock; 167 | match fn () with 168 | | x -> Mutex.unlock lock; x 169 | | exception ex -> 170 | let bt = Printexc.get_raw_backtrace () in 171 | Mutex.unlock lock; 172 | Printexc.raise_with_backtrace ex bt 173 | 174 | let find store hash path = 175 | with_lock @@ fun () -> 176 | Search_unsafe.find store hash path 177 | 178 | let read store hash = 179 | with_lock @@ fun () -> 180 | Store_unsafe.read store hash 181 | 182 | let pp_error = Store_unsafe.pp_error 183 | end 184 | ``` 185 | 186 | (note that e.g. `Search.find` is now `Store.find`) 187 | 188 | Now we get: 189 | ``` 190 | WARNING: ThreadSanitizer: data race (pid=146066) 191 | Read of size 8 at 0x7b7400000b20 by thread T1 (mutexes: write M81): 192 | #0 camlStdlib__Weak.find_aux_780 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:280 (main.exe+0x72986e) 193 | #1 camlOpamLexer.__ocaml_lex_token_rec_911 src/opamLexer.mll:134 (main.exe+0x4abf95) 194 | #2 camlOpamBaseParser.get_three_tokens_792 src/opamBaseParser.mly:185 (main.exe+0x4aa540) 195 | #3 camlOpamBaseParser.main_804 src/opamBaseParser.mly:228 (main.exe+0x4aa8e4) 196 | #4 camlOpamFile.parser_main_3913 src/format/opamFile.ml:739 (main.exe+0x45f7f3) 197 | #5 camlOpamFile.of_string_4595 src/format/opamFile.ml:761 (main.exe+0x4635e1) 198 | #6 camlOpamFile.read_from_f_1529 src/format/opamFile.ml:172 (main.exe+0x45b78e) 199 | #7 camlDune__exe__Packages.read_package_4943 solutions/4-eio-multicore/packages.ml:50 (main.exe+0x2dfbf9) 200 | ... 201 | Previous write of size 8 at 0x7b7400000b20 by thread T6 (mutexes: write M89): 202 | #0 caml_modify runtime/memory.c:219 (main.exe+0x7c0dbd) 203 | #1 camlStdlib__Weak.loop_769 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:253 (main.exe+0x729325) 204 | #2 camlStdlib__Weak.fun_1139 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:298 (main.exe+0x729db3) 205 | #3 camlOpamLexer.__ocaml_lex_token_rec_911 src/opamLexer.mll:134 (main.exe+0x4abf95) 206 | #4 camlOpamBaseParser.get_three_tokens_792 src/opamBaseParser.mly:185 (main.exe+0x4aa540) 207 | #5 camlOpamBaseParser.main_804 src/opamBaseParser.mly:228 (main.exe+0x4aa8e4) 208 | #6 camlOpamFile.parser_main_3913 src/format/opamFile.ml:739 (main.exe+0x45f7f3) 209 | #7 camlOpamFile.of_string_4595 src/format/opamFile.ml:761 (main.exe+0x4635e1) 210 | #8 camlOpamFile.read_from_f_1529 src/format/opamFile.ml:172 (main.exe+0x45b78e) 211 | #9 camlDune__exe__Packages.read_package_4943 solutions/4-eio-multicore/packages.ml:50 (main.exe+0x2dfbf9) 212 | ``` 213 | 214 | Looks like `OpamFile.read_from_string` isn't thread-safe either! Let's put another lock around that. 215 | 216 | Now we get: 217 | 218 | ``` 219 | Atomic read of size 8 at 0x7f5a244d7ac8 by thread T4 (mutexes: write M85, write M644): 220 | #0 do_check_key_clean runtime/weak.c:113 (main.exe+0x7d2a88) 221 | #1 clean_field runtime/weak.c:180 (main.exe+0x7d2a88) 222 | #2 ephe_check_field runtime/weak.c:401 (main.exe+0x7d3444) 223 | #3 caml_ephe_check_key runtime/weak.c:412 (main.exe+0x7d41bb) 224 | #4 caml_weak_check runtime/weak.c:417 (main.exe+0x7d41bb) 225 | #5 caml_c_call (main.exe+0x7d762f) 226 | #6 camlStdlib__Weak.check_398 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:60 (main.exe+0x726edb)#7 camlStdlib__Weak.loop_769 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:260 (main.exe+0x7294db)#8 camlStdlib__Weak.fun_1139 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/weak.ml:298 (main.exe+0x729d73)#9 camlOpamLexer.__ocaml_lex_token_rec_911 src/opamLexer.mll:126 (main.exe+0x4abcd9) 227 | #10 camlStdlib__Parsing.loop_521 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/parsing.ml:134 (main.exe+0x6ddf7e)lStdlib__Parsing.yyparse_515 /home/user/.opam/tsan/.opam-switch/build/ocaml-variants.5.2.0+trunk/stdlib/parsing.ml:165 (main.exe+0x6ddc99)amBaseParser.main_804 src/opamBaseParser.ml:460 (main.exe+0x4aac5c) 228 | #13 camlOpamFile.parser_main_3913 src/format/opamFile.ml:739 (main.exe+0x45f7b3) 229 | #14 camlOpamFile.of_string_4595 src/format/opamFile.ml:761 (main.exe+0x4635a1) 230 | #15 camlOpamFile.read_from_f_1529 src/format/opamFile.ml:172 (main.exe+0x45b74e) 231 | #16 camlDune__exe__Opam_lock.use_289 solutions/4-eio-multicore/opam_lock.ml:5 (main.exe+0x2e0f39) 232 | #17 camlDune__exe__Packages.read_package_4943 solutions/4-eio-multicore/packages.ml:51 (main.exe+0x2dfc39) 233 | ... 234 | Previous write of size 8 at 0x7f5a244d7ac8 by thread T2 (mutexes: write M81): 235 | #0 caml_ephe_clean runtime/weak.c:154 (main.exe+0x7d29b7) 236 | #1 caml_ephe_clean runtime/weak.c:173 (main.exe+0x7d3967) 237 | #2 ephe_sweep runtime/major_gc.c:1225 (main.exe+0x7beb42) 238 | #3 major_collection_slice runtime/major_gc.c:1684 (main.exe+0x7beb42) 239 | ``` 240 | 241 | This might be a bug in ocaml-tsan. We shouldn't be conflicting with the GC! 242 | See https://github.com/google/sanitizers/wiki/ThreadSanitizerSuppressions for how to suppress warnings. 243 | For example: 244 | 245 | ``` 246 | # The GC isn't our problem: 247 | race:caml_major_collection_slice 248 | 249 | # Suppressions aren't reliable if there's no stack 250 | race:failed to restore the stack 251 | ``` 252 | 253 | ## Performance 254 | 255 | OK, let's see how much faster it is with 3 workers rather than 1! 256 | (don't forget to switch back to the regular switch; tsan is really slow) 257 | 258 | Testing on my Framework laptop, I get: 259 | 260 | ``` 261 | +Finished in 4.56 s # Single-core, cold cache 262 | +Finished in 5.46 s # Three cores, cold cache 263 | ``` 264 | 265 | Hmm. It's about a second slower. 266 | 267 | BUT that's in the cold-cache case where we're spending most of the time loading and parsing opam files, 268 | which can't be done in parallel as we saw above. But running the tests again without restarting the solver, 269 | we see the benefit: 270 | 271 | ``` 272 | +Finished in 1.29 s # Single-core, warm cache 273 | +Finished in 0.64 s # Three cores, warm cache 274 | ``` 275 | 276 | About twice as fast! 277 | 278 | However, Jon's macbook gets more reasonable results: 279 | ``` 280 | cold warm 281 | 2-lwt-eio : 6.24 1.53 282 | 3-eio : 6.06 1.51 283 | 4-eio-multicore : 5.21 0.55 284 | ``` 285 | 286 | If you get unexpected performance problems, there are several tools that might prove useful: 287 | 288 | ## Magic-trace 289 | 290 | If you have a supported system, [magic-trace][] is a useful tracing tool. Run with: 291 | ```sh 292 | magic-trace run -multi-thread _build/default/service/main.exe -- ../opam-repository -v 293 | ``` 294 | Then view the results at https://magic-trace.org/. 295 | 296 | However, magic-trace can only report the last few ms of execution. 297 | We see most threads are just waiting to be woken up (presumably they are waiting for a mutex). 298 | 299 | ## Olly 300 | 301 | OCaml 5.1 adds support for custom events, which can be useful to see what an Eio program is doing. 302 | 303 | To try it, you'd need to apply [Eio PR#554](https://github.com/ocaml-multicore/eio/pull/554) to generate 304 | events, turn on tracing in Eio, and use the Git version of the [olly][] tool: 305 | 306 | ``` 307 | opam pin runtime_events_tools https://github.com/TheLortex/runtime_events_tools.git 308 | ``` 309 | 310 | However, there are some bugs that make this less useful at the moment; 311 | e.g. you'll need to find a fix for https://github.com/tarides/runtime_events_tools/issues/20. 312 | 313 | ## Flame graphs 314 | 315 | The `offcputime` tool records when an OS thread is suspended and resumed. 316 | This can be used to see how much time is being spent waiting. 317 | For example: 318 | 319 | ``` 320 | apt install bpfcc-tools 321 | sudo /usr/sbin/offcputime-bpfcc -df -p (pgrep -f server/main.exe) 2 > out.stacks 322 | ``` 323 | 324 | Again, this shows a large amount of time waiting for mutexes. 325 | 326 | See: https://www.brendangregg.com/flamegraphs.html 327 | 328 | ## Update 329 | 330 | For a detailed investigation of the performance of the solver service, 331 | see the [OCaml 5 Performance Part 2](https://roscidus.com/blog/blog/2024/07/22/performance-2/) blog post. 332 | 333 | [olly]: https://github.com/tarides/runtime_events_tools 334 | [magic-trace]: https://github.com/janestreet/magic-trace 335 | -------------------------------------------------------------------------------- /doc/porting.md: -------------------------------------------------------------------------------- 1 | # Porting an Lwt application to Eio 2 | 3 | Before starting, ensure you have this repository cloned and the dependencies installed: 4 | 5 | ```sh 6 | git clone --recursive https://github.com/ocaml-multicore/icfp-2023-eio-tutorial.git 7 | cd icfp-2023-eio-tutorial 8 | opam install --deps-only -t . 9 | dune build 10 | ``` 11 | 12 | ## The example application 13 | 14 | We'll be converting a solver service, which can be found in the `server` directory. 15 | It is a web-service that takes an opam-repository commit hash and a package name 16 | and returns a set of packages that need to be installed to use it 17 | (it is a simplified version of the [ocaml-ci solver service](https://github.com/ocurrent/solver-service/)). 18 | 19 | To test it, start by running the service: 20 | 21 | ``` 22 | $ dune exec -- ./server/main.exe ../opam-repository -v 23 | main.exe: [INFO] Starting server... 24 | Server listening on TCP port 8080 25 | ``` 26 | 27 | Then, in another window use the test client to perform some queries: 28 | 29 | ``` 30 | $ make test 31 | dune exec -- ./client/main.exe 32 | +Requesting http://127.0.0.1:8080/solve/9faf3dbf816f376733b73f3ed8832c4213db4a02/lwt?ocaml_version=4.02.0 33 | +Requesting http://127.0.0.1:8080/solve/9faf3dbf816f376733b73f3ed8832c4213db4a02/lwt?ocaml_version=4.14.0 34 | +Requesting http://127.0.0.1:8080/solve/9faf3dbf816f376733b73f3ed8832c4213db4a02/lwt?ocaml_version=5.0.0 35 | +5.0.0 : base-bigarray.base base-bytes.base base-domains.base base-nnp.base base-threads.base base-unix.base cppo.1.6.9 csexp.1.5.2 dune.3.9.1 dune-configurator.3.9.1 lwt.5.6.1 ocaml.5.0.0 ocaml-base-compiler.5.0.0 ocaml-config.3 ocaml-options-vanilla.1 ocamlfind.1.9.6 ocplib-endian.1.2 36 | +4.14.0 : base-bigarray.base base-bytes.base base-threads.base base-unix.base cppo.1.6.9 csexp.1.5.2 dune.3.9.1 dune-configurator.3.9.1 lwt.5.6.1 ocaml.4.14.0 ocaml-base-compiler.4.14.0 ocaml-config.2 ocaml-options-vanilla.1 ocamlfind.1.9.6 ocplib-endian.1.2 37 | +4.02.0 : base-bigarray.base base-bytes.base base-ocamlbuild.base base-threads.base base-unix.base cppo.1.6.5 dune.1.11.4 dune-configurator.1.0.0 jbuilder.transition lwt.5.2.0 mmap.1.1.0 ocaml.4.02.0 ocaml-base-compiler.4.02.0 ocaml-config.1 ocamlbuild.0 ocamlfind.1.9.6 ocplib-endian.1.0 result.1.5 seq.0.2.2 38 | +Finished in 20.22 s 39 | ``` 40 | 41 | It's a bit slow the first time (as it loads all the opam files), 42 | but if you run the client again without restarting the server then it will be much faster. 43 | We'll fix the slow start-up soon! 44 | 45 | ## Switching to Eio_main 46 | 47 | Eio and Lwt code can run at the same time, using the [Lwt_eio][] library. 48 | 49 | Begin by adding the `eio_main` and `lwt_eio` libraries to the `dune` file. 50 | 51 | Then, find the `Lwt_main.run` call and replace it with these three lines: 52 | 53 | ```ocaml 54 | Eio_main.run @@ fun env -> 55 | Lwt_eio.with_event_loop ~debug:true ~clock:env#clock @@ fun _ -> 56 | Lwt_eio.run_lwt @@ fun () -> 57 | ``` 58 | 59 | We're now using the Eio event loop instead of the normal Lwt one, but everything else stays the same: 60 | 61 | - `Eio_main.run` starts the Eio event loop, replacing `Lwt_main.run`. 62 | - `Lwt_eio.with_event_loop` starts the Lwt event loop, using Eio as its backend. 63 | - `Lwt_eio.run_lwt` switches from Eio context to Lwt context. 64 | 65 | Any piece of code is either Lwt code or Eio code. 66 | You use `run_lwt` and `run_eio` to switch back and forth as necessary 67 | (`run_lwt` lets Eio code call Lwt code, while `run_eio` lets Lwt code call Eio). 68 | 69 | The `~debug:true` tells Lwt_eio to check that you don't perform Eio operations from 70 | a Lwt context (doing so would cause the other Lwt threads to hang). 71 | 72 | Run the new version to check that it still works. 73 | 74 | ### Overview of the code 75 | 76 | - `Main` parses the commmand-line arguments and runs the web-server. 77 | It uses `Git_unix` to open the `opam-repository` clone and `Solver` to find solutions to client requests. 78 | 79 | - `Solver` uses `Packages` to load the opam files from the Git store and then uses the 0install solver to find a solution. 80 | It caches the packages of the last used Git commit to make future runs faster. 81 | 82 | - `Context` is used by the 0install solver to get the opam package data. 83 | It mostly just wraps a call to `Packages.get_versions`. 84 | 85 | - `Packages` loads the opam files from the Git store. 86 | It starts with a Git commit (provided by the user) 87 | and uses that to get the Git "tree" corresponding to that commit's root directory. 88 | Then it gets the `packages` sub-directory, and loads each sub-directory of that as a package. 89 | For each package, it loads each sub-directory as a version. 90 | For each version, it loads the `opam` file. 91 | For example, `packages/lwt/lwt.5.7.0/opam ` is the opam metadata for Lwt 5.7.0. 92 | See [Git internals][] if you want to know more about how Git stores data. 93 | 94 | ### Converting the code 95 | 96 | We can take any piece of Lwt code and switch it to Eio. 97 | 98 | For example, we can change `Packages.of_commit` (which currently contains only Lwt code) 99 | and put `Lwt_eio.run_lwt @@ fun () ->` at the start (leaving the rest of the code the same). 100 | Now the function is an Eio function, returning `Packages.t` rather than `Packages.t Lwt.t`. 101 | 102 | We can still use the function from Lwt context by using `run_eio`. So: 103 | 104 | ```ocaml 105 | Packages.of_commit t.store commit >|= fun pkgs -> 106 | ``` 107 | 108 | becomes 109 | 110 | ```ocaml 111 | Lwt_eio.run_eio (fun () -> Packages.of_commit t.store commit) >|= fun pkgs -> 112 | ``` 113 | 114 | But instead, let's convert the `packages` function to Eio. 115 | We could just replace the Lwt promise with an Eio promise 116 | (so that `Lwt.wait ()` becomes `Eio.Promise.create ()`), 117 | but a more elegant solution is to use `Eio.Lazy`: 118 | 119 | ```ocaml 120 | let packages t commit = 121 | match t.packages_cache with 122 | | Some (c, p) when Git_unix.Store.Hash.equal c commit -> Eio.Lazy.force p 123 | | _ -> 124 | let p = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> 125 | Log.info (fun f -> f "Loading packages..."); 126 | let pkgs = Packages.of_commit t.store commit in 127 | Log.info (fun f -> f "Loaded packages"); 128 | pkgs 129 | ) in 130 | t.packages_cache <- Some (commit, p); 131 | Eio.Lazy.force p 132 | ``` 133 | 134 | Hint: you'll need to change the type of `t.packages_cache` too. 135 | 136 | Unlike `Stdlib.Lazy`, `Eio.Lazy` allows multiple fibers to force the value at once. 137 | The first fiber to do so will load it, and the others will wait. 138 | 139 | Since Eio fibers can be cancelled, Eio requires us to say what should happen in this case. 140 | ``~cancel:`Restart`` says that if the first fiber is cancelled, the next one will take over. 141 | (note: Lwt also allows cancellation, and ideally should also handle that here somehow, 142 | but this particular application doesn't need it) 143 | 144 | Now `solve` no longer needs to use the Lwt `>|=` operator when creating packages, so 145 | 146 | ```ocaml 147 | packages t commit >|= fun packages -> 148 | ``` 149 | becomes: 150 | ```ocaml 151 | let packages = packages t commit in 152 | ``` 153 | 154 | `solve` didn't contain any other Lwt code, so it is now an Eio function too. 155 | Or rather, it's a plain OCaml function. 156 | We removed the Lwt operator, but we didn't replace it with anything from Eio. 157 | In fact, much of "converting from Lwt to Eio" is really just "removing Lwt"! 158 | 159 | Finally, the call to `Solver.solve` in `main.ml` no longer needs to use `>>= function`, but 160 | can instead be a plain OCaml `match` expression. 161 | 162 | But be careful! `Solver.solve` is now an Eio function (it indirectly calls `Lwt_eio.run_lwt`), 163 | so it needs to be called from Eio context. 164 | Since we're using `Lwt_eio.with_event_loop ~debug:true`, this will be detected when you test it: 165 | 166 | ``` 167 | main.exe: [INFO] Loading packages... 168 | +WARNING: Exception: Failure("Already in Lwt context!") 169 | + Raised by primitive operation at Lwt_eio.with_mode in file "vendor/lwt_eio/lib/lwt_eio.ml", line 70, characters 13-84 170 | + Called from Lwt_eio.run_lwt in file "vendor/lwt_eio/lib/lwt_eio.ml", line 268, characters 10-26 171 | + Called from Eio__Lazy.from_fun.force in file "vendor/eio/lib_eio/lazy.ml", line 17, characters 55-60 172 | + Called from Eio__Lazy.force in file "vendor/eio/lib_eio/lazy.ml", line 46, characters 54-58 173 | + Called from Dune__exe__Solver.packages in file "server/solver.ml", line 43, characters 12-28 174 | ``` 175 | 176 | Here, cohttp was running in Lwt context, so when `Packages.of_commit` did `run_lwt`, it reported a problem. 177 | We could fix it by changing contexts some more: 178 | 179 | ```ocaml 180 | Lwt_eio.run_eio @@ fun () -> 181 | match Solver.solve solver request with 182 | | Ok selection -> 183 | let body = selection |> List.map OpamPackage.to_string |> String.concat " " in 184 | Lwt_eio.run_lwt @@ fun () -> 185 | Server.respond_string ~status:`OK ~body () 186 | | Error msg -> 187 | Lwt_eio.run_lwt @@ fun () -> 188 | Server.respond_string ~status:`OK ~body:msg () 189 | ``` 190 | 191 | However, this would probably be a good time to switch to cohttp-eio! 192 | To start, replace the `Cohttp_lwt_unix.Server` with `Cohttp_eio.Server` and 193 | update the `dune` file to use `cohttp-eio` instead of `cohttp-lwt-unix`. 194 | 195 | You'll find that `Server.create` has gone. 196 | Eio separates creation of the listening socket from running the server, 197 | so we can start listening right at the beginning. 198 | We'll have `main` take a listening socket rather than a port, 199 | and replace the `Server.create` with `Server.run`: 200 | 201 | ```ocaml 202 | let main ~socket opam_repo = 203 | ... 204 | Server.run socket (Server.make ~callback ()) 205 | ~on_error:(traceln "Error handling connection: %a" Fmt.exn) 206 | ``` 207 | 208 | We can also remove the `open Lwt.Infix` and delete the last `>>=` from `main.ml`, 209 | using `match Lwt_eio.run_lwt ... with` for the remaining Lwt Git_unix call. 210 | This converts `main` into a Eio function. 211 | 212 | Finally, create the listening socket in the start-up code: 213 | 214 | ```ocaml 215 | let () = 216 | let info = Cmd.info "solver service" in 217 | let main () port opam_repo = 218 | Eio_main.run @@ fun env -> 219 | Lwt_eio.with_event_loop ~clock:env#clock @@ fun _ -> 220 | Switch.run @@ fun sw -> 221 | let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in 222 | let socket = Eio.Net.listen ~sw ~backlog:5 ~reuse_addr:true env#net addr in 223 | traceln "Server listening on TCP port %d" port; 224 | main ~socket opam_repo 225 | in 226 | exit @@ Cmd.eval @@ Cmd.v info 227 | Term.(const main $ setup_log $ port $ opam_dir) 228 | ``` 229 | 230 | As always after making changes, it's a good idea to run the tests again and check that it's still working. 231 | 232 | ### Taking advantage of Eio 233 | 234 | Removing `>>=`, `>|=` and `Lwt.return` from our code makes it a bit cleaner, 235 | and can avoid depending on a concurrency library at all. 236 | But there are more important benefits! 237 | 238 | `Packages.candidates` is defined as: 239 | 240 | ```ocaml 241 | type candidates = OpamFile.OPAM.t Lazy.t OpamPackage.Version.Map.t 242 | ``` 243 | 244 | Since we don't need to parse most of the opam files in the repository, the actual parsing is done lazily 245 | (hence `OpamFile.OPAM.t Lazy.t`). 246 | It would be even better if we could avoid loading the files until we need them too, 247 | but we couldn't do that with Lwt. 248 | 249 | The reason is that the solver library doesn't know about Lwt. 250 | It requires us to provide a function (`Context.candidates`) with this non-Lwt signature: 251 | 252 | ```ocaml 253 | val candidates : t -> OpamPackage.Name.t -> (OpamPackage.Version.t * (OpamFile.OPAM.t, rejection) result) list 254 | ``` 255 | 256 | We can't do any Lwt operations (such as `Git_unix.Store.read`) because they only give us a promise of the result, 257 | not the result itself. 258 | Without effects, we'd have to add a Lwt dependency to the solver (or functorise it over a user-specified monad). 259 | But with effects, there's no problem. `Lwt_eio.run_lwt` has exactly the type we need: 260 | 261 | ```ocaml 262 | val run_lwt : (unit -> 'a Lwt.t) -> 'a 263 | ``` 264 | 265 | Change `Packages.candidates` so that we lazily load all the versions for a given package, like this: 266 | 267 | ```ocaml 268 | type candidates = OpamFile.OPAM.t OpamPackage.Version.Map.t Eio.Lazy.t 269 | ``` 270 | 271 | Hints: 272 | 273 | - You'll need to think about which functions are now Eio functions, and which are still Lwt. 274 | - Use `Eio.Lazy` (not plain `Lazy`) to make sure it won't crash with concurrent requests. 275 | 276 | You should find the server runs much faster the first time now, since it only has to load the packages it needs. 277 | 278 | ## Completing the port 279 | 280 | To finish the port, you can also switch to using `git-eio` instead of `git-unix`. 281 | 282 | Hints: 283 | 284 | - `Lwt_list.filter_map_p` can be replaced with `Eio.Fiber.List.filter_map`. 285 | - `Lwt_list.filter_map_s` becomes just `List.filter_map`. 286 | - Some Git modules have moved; e.g. `Git.Value` becomes `Git_eio.Value`. 287 | - `main` should take an `Eio.Path.t` argument, not a string. 288 | Use `Eio.Path.pp` to display it. 289 | - To get the path, call main like this: 290 | ```ocaml 291 | let ( / ) = Eio.Path.( / ) in 292 | Eio.Path.with_open_dir (env#fs / opam_repo) @@ fun opam_repo -> 293 | main ~socket opam_repo 294 | ``` 295 | 296 | Then we can remove the `Lwt_eio.with_event_loop` and the dependencies on `lwt_eio` and `lwt`. 297 | 298 | Check that your final version still works by restarting the server and running `make test` again. 299 | You might like to compare your final version with our solution in `solutions/3-eio`. 300 | 301 | ## Next 302 | 303 | [Using multiple cores](./multicore.md) 304 | 305 | [Git internals]: https://git-scm.com/book/en/v2/Git-Internals-Git-Objects 306 | [Lwt_eio]: https://github.com/ocaml-multicore/lwt_eio 307 | -------------------------------------------------------------------------------- /doc/prereqs.md: -------------------------------------------------------------------------------- 1 | ## Prerequisites 2 | 3 | You will need OCaml 5.1 or later, which can be installed using [opam](https://opam.ocaml.org/): 4 | 5 | ```sh 6 | opam switch create 5.1.0 7 | ``` 8 | 9 | For profiling with `perf` (Linux-only), it may be helpful to use a compiler with frame-pointers enabled instead, like this: 10 | 11 | ```sh 12 | opam switch create 5.1.0+fp ocaml-variants.5.1.0+options ocaml-option-fp 13 | ``` 14 | 15 | This repository uses Git submodules. Make sure they're enabled with: 16 | 17 | ```sh 18 | git submodule update --init --recursive 19 | ``` 20 | 21 | The dependencies needed for the example program are given in the `tutorial.opam` file, and can be installed with: 22 | 23 | ```sh 24 | opam install --deps-only -t . 25 | ``` 26 | 27 | The application also requires a copy of opam-repository (note: if using the Docker build below, this isn't needed as the Docker image already has a copy): 28 | 29 | ```sh 30 | git clone https://github.com/ocaml/opam-repository.git 31 | ``` 32 | 33 | You should then be able to build the examples with: 34 | 35 | ```sh 36 | dune build 37 | ``` 38 | 39 | ## Docker 40 | 41 | There is also a `Dockerfile`, which can be used to create a Docker container with the examples built. 42 | 43 | ```ocaml 44 | docker build -t icfp . 45 | ``` 46 | 47 | This is an easy way to use Linux profiling tools on macos or Windows machines. 48 | It takes a while to build, so it's a good idea to do that ahead of time. 49 | 50 | ## ThreadSanitizer 51 | 52 | For finding races, you might also want a compiler with `tsan` enabled: 53 | ```sh 54 | sudo apt install libunwind-dev 55 | opam switch create 5.1.0+tsan 56 | ``` 57 | Warning: you will need plenty of memory to compile some packages on this switch, and the build will fail if it runs out of memory. 58 | 59 | The Docker image includes commented-out blocks that install a switch with ThreadSanitizer. Please uncomment the two blocks to try this. Note that at time of writing this does not work on M1/M2 macs. 60 | 61 | ## Next 62 | 63 | [Eio introduction and Lwt comparison](./intro.md) 64 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (dirs (:standard \ opam-repository)) 2 | (vendored_dirs vendor) 3 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 3.9) 2 | (formatting disabled) 3 | -------------------------------------------------------------------------------- /server/context.ml: -------------------------------------------------------------------------------- 1 | (* This module is used by the solver to get the candiate versions of each packages. *) 2 | 3 | type rejection = 4 | | UserConstraint of OpamFormula.atom 5 | | Unavailable 6 | 7 | type t = { 8 | env : string -> OpamVariable.variable_contents option; 9 | packages : Packages.t; 10 | constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 11 | } 12 | 13 | let user_restrictions t name = 14 | OpamPackage.Name.Map.find_opt name t.constraints 15 | 16 | let dev = OpamPackage.Version.of_string "dev" 17 | 18 | let env t pkg v = 19 | if List.mem v OpamPackageVar.predefined_depends_variables then None 20 | else match OpamVariable.Full.to_string v with 21 | | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg))) 22 | | x -> t.env x 23 | 24 | let filter_deps t pkg f = 25 | let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in 26 | f 27 | |> OpamFilter.partial_filter_formula (env t pkg) 28 | |> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false ~dev ~default:false 29 | 30 | let candidates t name = 31 | let user_constraints = user_restrictions t name in 32 | Packages.get_versions t.packages name 33 | |> OpamPackage.Version.Map.bindings 34 | |> List.rev 35 | |> List.map (fun (v, opam) -> 36 | match user_constraints with 37 | | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> 38 | v, Error (UserConstraint (name, Some test)) 39 | | _ -> 40 | let pkg = OpamPackage.create name v in 41 | let available = OpamFile.OPAM.available opam in 42 | match OpamFilter.eval_to_bool ~default:false (env t pkg) available with 43 | | true -> v, Ok opam 44 | | false -> v, Error Unavailable 45 | ) 46 | 47 | let pp_rejection f = function 48 | | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x) 49 | | Unavailable -> Fmt.string f "Availability condition not satisfied" 50 | 51 | let create ~constraints ~env packages = 52 | { env; packages; constraints } 53 | -------------------------------------------------------------------------------- /server/context.mli: -------------------------------------------------------------------------------- 1 | include Opam_0install.S.CONTEXT 2 | 3 | val create : 4 | constraints:OpamFormula.version_constraint OpamTypes.name_map -> 5 | env:(string -> OpamVariable.variable_contents option) -> 6 | Packages.t -> 7 | t 8 | (** [create ~constraints ~env packages] loads information about candidate packages from [packages], 9 | sorts and filters them, and provides them to the solver. 10 | 11 | @param constraints Allows filtering out candidates before they get to the solver. 12 | @param env Details about the target platform. *) 13 | -------------------------------------------------------------------------------- /server/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries lwt cohttp-lwt-unix opam-format opam-0install git-unix fmt.cli logs.cli fmt.tty logs.fmt)) 4 | -------------------------------------------------------------------------------- /server/log.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "solver-service" ~doc:"Solver service" 2 | include (val Logs.src_log src : Logs.LOG) 3 | -------------------------------------------------------------------------------- /server/main.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | 3 | module Request = Cohttp.Request 4 | module Server = Cohttp_lwt_unix.Server 5 | 6 | let parse_request req = 7 | let uri = Request.uri req in 8 | let path = 9 | uri 10 | |> Uri.path 11 | |> String.split_on_char '/' 12 | |> List.filter ((<>) "") 13 | in 14 | match Request.meth req, path with 15 | | `GET, [] -> `Main 16 | | `GET, ["solve"; commit; pkg] -> 17 | let pkg = OpamPackage.Name.of_string pkg in 18 | let commit = Git_unix.Store.Hash.of_hex commit in 19 | begin match Uri.get_query_param uri "ocaml_version" with 20 | | Some v -> 21 | let ocaml_version = (`Eq, OpamPackage.Version.of_string v) in 22 | `Solve { Solver.pkg; commit; ocaml_version } 23 | | None -> `Bad_request "Missing ocaml_version" 24 | end; 25 | | _, _ -> `Not_found 26 | 27 | let main ~port opam_repo = 28 | Log.info (fun f -> f "Starting server..."); 29 | Git_unix.Store.v (Fpath.v opam_repo) >>= function 30 | | Error e -> Fmt.failwith "Can't open Git store %S: %a" opam_repo Git_unix.Store.pp_error e 31 | | Ok store -> 32 | let solver = Solver.create store in 33 | let callback _conn req _body = 34 | match parse_request req with 35 | | `Main -> Server.respond_string ~status:`OK ~body:"Usage: GET /solve/COMMIT/PKG?ocaml_version=VERSION" () 36 | | `Not_found -> Server.respond_string ~status:`Not_found ~body:"Not found" () 37 | | `Bad_request msg -> Server.respond_string ~status:`Bad_request ~body:msg () 38 | | `Solve request -> 39 | Solver.solve solver request >>= function 40 | | Ok selection -> 41 | let body = selection |> List.map OpamPackage.to_string |> String.concat " " in 42 | Server.respond_string ~status:`OK ~body () 43 | | Error msg -> 44 | Server.respond_string ~status:`OK ~body:msg () 45 | in 46 | let server = Server.create ~mode:(`TCP (`Port port)) (Server.make ~callback ()) in 47 | Fmt.pr "Server listening on TCP port %d@." port; 48 | server 49 | 50 | (* Command-line interface *) 51 | 52 | let setup_log style_renderer level = 53 | Fmt_tty.setup_std_outputs ?style_renderer (); 54 | Logs.set_level level; 55 | Logs.set_reporter (Logs_fmt.reporter ()); 56 | () 57 | 58 | open Cmdliner 59 | 60 | let setup_log = 61 | Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 62 | 63 | let port = 64 | Arg.value @@ 65 | Arg.opt Arg.int 8080 @@ 66 | Arg.info 67 | ~doc:"The port to listen on" 68 | ~docv:"PORT" 69 | ["port"] 70 | 71 | let opam_dir = 72 | Arg.required @@ 73 | Arg.pos 0 Arg.(some dir) None @@ 74 | Arg.info 75 | ~doc:"The path of an opam-repository clone" 76 | ~docv:"DIR" 77 | [] 78 | 79 | let () = 80 | let info = Cmd.info "solver service" in 81 | let main () port opam_repo = 82 | Lwt_main.run (main ~port opam_repo) 83 | in 84 | exit @@ Cmd.eval @@ Cmd.v info 85 | Term.(const main $ setup_log $ port $ opam_dir) 86 | -------------------------------------------------------------------------------- /server/packages.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | 3 | module Store = Git_unix.Store 4 | module Search = Git.Search.Make (Digestif.SHA1) (Store) 5 | 6 | (* The set of versions available for some package name. To speed things up, we 7 | parse the opam files lazily. 8 | 9 | Ideally we'd also load the files lazily, but [get_versions] can't return a 10 | Lwt promise, as the solver doesn't use Lwt, so we can't use Git_unix 11 | in the solver callback. *) 12 | type candidates = OpamFile.OPAM.t Lazy.t OpamPackage.Version.Map.t 13 | 14 | type t = candidates OpamPackage.Name.Map.t 15 | 16 | (* Load a Git directory tree from the store by hash. *) 17 | let read_dir store hash = 18 | Store.read store hash >|= function 19 | | Error e -> Fmt.failwith "Failed to read tree: %a" Store.pp_error e 20 | | Ok (Git.Value.Tree tree) -> Some tree 21 | | Ok _ -> None 22 | 23 | (* Load [pkg]'s opam file from its directory. *) 24 | let read_package store pkg hash = 25 | Search.find store hash (`Path [ "opam" ]) >>= function 26 | | None -> 27 | Fmt.failwith "opam file not found for %s" (OpamPackage.to_string pkg) 28 | | Some hash -> ( 29 | Store.read store hash >|= function 30 | | Ok (Git.Value.Blob blob) -> 31 | let blob = Store.Value.Blob.to_string blob in 32 | lazy ( 33 | try OpamFile.OPAM.read_from_string blob 34 | with ex -> 35 | Fmt.failwith "Error parsing %s: %s" (OpamPackage.to_string pkg) (Printexc.to_string ex) 36 | ) 37 | | _ -> 38 | Fmt.failwith "Bad Git object type for %s!" (OpamPackage.to_string pkg) 39 | ) 40 | 41 | (* Get a map of the versions inside [entry] (an entry under "packages") *) 42 | let read_versions store (entry : Store.Value.Tree.entry) : candidates Lwt.t = 43 | read_dir store entry.node >>= function 44 | | None -> Lwt.return OpamPackage.Version.Map.empty 45 | | Some tree -> 46 | Store.Value.Tree.to_list tree 47 | |> Lwt_list.filter_map_p (fun (entry : Store.Value.Tree.entry) -> 48 | match OpamPackage.of_string_opt entry.name with 49 | | Some pkg -> 50 | read_package store pkg entry.node >|= fun opam -> 51 | Some (pkg.version, opam) 52 | | None -> 53 | Log.info (fun f -> f "Invalid package name %S" entry.name); 54 | Lwt.return None 55 | ) 56 | >|= OpamPackage.Version.Map.of_list 57 | 58 | let read_packages ~store tree = 59 | Store.Value.Tree.to_list tree 60 | |> Lwt_list.filter_map_s (fun (entry : Store.Value.Tree.entry) -> 61 | Log.info (fun f -> f "Found %S" entry.name); 62 | match OpamPackage.Name.of_string entry.name with 63 | | exception ex -> 64 | Log.warn (fun f -> f "Invalid package name %S: %a" entry.name Fmt.exn ex); 65 | Lwt.return_none 66 | | name -> 67 | read_versions store entry >|= fun versions -> 68 | Some (name, versions) 69 | ) 70 | >|= OpamPackage.Name.Map.of_list 71 | 72 | let of_commit store commit : t Lwt.t = 73 | Search.find store commit (`Commit (`Path [ "packages" ])) >>= function 74 | | None -> Fmt.failwith "Failed to find packages directory!" 75 | | Some tree_hash -> 76 | read_dir store tree_hash >>= function 77 | | None -> Fmt.failwith "'packages' is not a directory!" 78 | | Some tree -> read_packages ~store tree 79 | 80 | let get_versions (t:t) name = 81 | match OpamPackage.Name.Map.find_opt name t with 82 | | None -> OpamPackage.Version.Map.empty 83 | | Some versions -> OpamPackage.Version.Map.map Lazy.force versions 84 | -------------------------------------------------------------------------------- /server/packages.mli: -------------------------------------------------------------------------------- 1 | (** Loads opam package metadata from an opam-respository commit. *) 2 | 3 | type t 4 | (** A particular commit of opam-repository. *) 5 | 6 | val of_commit : Git_unix.Store.t -> Git_unix.Store.Hash.t -> t Lwt.t 7 | (** [of_commit store hash] provides the packages at commit [hash] in [store]. *) 8 | 9 | val get_versions : t -> OpamPackage.Name.t -> OpamFile.OPAM.t OpamPackage.Version.Map.t 10 | (** [get_versions t pkg] returns all available versions of [pkg] in [t]. *) 11 | -------------------------------------------------------------------------------- /server/solver.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | 3 | module Solver = Opam_0install.Solver.Make(Context) 4 | 5 | type t = { 6 | store : Git_unix.Store.t; 7 | mutable packages_cache : (Git_unix.Store.Hash.t * Packages.t Lwt.t) option; 8 | } 9 | 10 | type request = { 11 | pkg : OpamPackage.Name.t; 12 | commit : Git_unix.Store.Hash.t; 13 | ocaml_version : OpamFormula.version_constraint; 14 | } 15 | 16 | let std_env 17 | ?(ocaml_native=true) 18 | ?sys_ocaml_version 19 | ?opam_version 20 | ~arch ~os ~os_distribution ~os_family ~os_version 21 | () = 22 | function 23 | | "arch" -> Some (OpamTypes.S arch) 24 | | "os" -> Some (OpamTypes.S os) 25 | | "os-distribution" -> Some (OpamTypes.S os_distribution) 26 | | "os-version" -> Some (OpamTypes.S os_version) 27 | | "os-family" -> Some (OpamTypes.S os_family) 28 | | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 29 | | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v) 30 | | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 31 | | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 32 | | v -> 33 | OpamConsole.warning "Unknown variable %S" v; 34 | None 35 | 36 | let ocaml = OpamPackage.Name.of_string "ocaml" 37 | 38 | let packages t commit = 39 | match t.packages_cache with 40 | | Some (c, p) when Git_unix.Store.Hash.equal c commit -> p 41 | | _ -> 42 | Log.info (fun f -> f "Loading packages..."); 43 | let p, r = Lwt.wait () in 44 | t.packages_cache <- Some (commit, p); 45 | Packages.of_commit t.store commit >|= fun pkgs -> 46 | Log.info (fun f -> f "Loaded packages"); 47 | Lwt.wakeup r pkgs; 48 | pkgs 49 | 50 | let solve t { pkg; commit; ocaml_version } = 51 | let env = std_env () 52 | ~os:"linux" 53 | ~os_family:"debian" 54 | ~os_distribution:"debian" 55 | ~os_version:"12" 56 | ~arch:"x86_64" 57 | in 58 | packages t commit >|= fun packages -> 59 | let constraints = OpamPackage.Name.Map.singleton ocaml ocaml_version in 60 | let ctx = Context.create ~env ~constraints packages in 61 | match Solver.solve ctx [pkg] with 62 | | Ok x -> Ok (Solver.packages_of_result x) 63 | | Error e -> Error (Solver.diagnostics e) 64 | | exception ex -> Fmt.epr "Solver: %a@." Fmt.exn ex; raise ex 65 | 66 | let create store = { store; packages_cache = None } 67 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/context.ml: -------------------------------------------------------------------------------- 1 | (* This module is used by the solver to get the candiate versions of each packages. *) 2 | 3 | type rejection = 4 | | UserConstraint of OpamFormula.atom 5 | | Unavailable 6 | 7 | type t = { 8 | env : string -> OpamVariable.variable_contents option; 9 | packages : Packages.t; 10 | constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 11 | } 12 | 13 | let user_restrictions t name = 14 | OpamPackage.Name.Map.find_opt name t.constraints 15 | 16 | let dev = OpamPackage.Version.of_string "dev" 17 | 18 | let env t pkg v = 19 | if List.mem v OpamPackageVar.predefined_depends_variables then None 20 | else match OpamVariable.Full.to_string v with 21 | | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg))) 22 | | x -> t.env x 23 | 24 | let filter_deps t pkg f = 25 | let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in 26 | f 27 | |> OpamFilter.partial_filter_formula (env t pkg) 28 | |> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false ~dev ~default:false 29 | 30 | let candidates t name = 31 | let user_constraints = user_restrictions t name in 32 | Packages.get_versions t.packages name 33 | |> OpamPackage.Version.Map.bindings 34 | |> List.rev 35 | |> List.map (fun (v, opam) -> 36 | match user_constraints with 37 | | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> 38 | v, Error (UserConstraint (name, Some test)) 39 | | _ -> 40 | let pkg = OpamPackage.create name v in 41 | let available = OpamFile.OPAM.available opam in 42 | match OpamFilter.eval_to_bool ~default:false (env t pkg) available with 43 | | true -> v, Ok opam 44 | | false -> v, Error Unavailable 45 | ) 46 | 47 | let pp_rejection f = function 48 | | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x) 49 | | Unavailable -> Fmt.string f "Availability condition not satisfied" 50 | 51 | let create ~constraints ~env packages = 52 | { env; packages; constraints } 53 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/context.mli: -------------------------------------------------------------------------------- 1 | include Opam_0install.S.CONTEXT 2 | 3 | val create : 4 | constraints:OpamFormula.version_constraint OpamTypes.name_map -> 5 | env:(string -> OpamVariable.variable_contents option) -> 6 | Packages.t -> 7 | t 8 | (** [create ~constraints ~env packages] loads information about candidate packages from [packages], 9 | sorts and filters them, and provides them to the solver. 10 | 11 | @param constraints Allows filtering out candidates before they get to the solver. 12 | @param env Details about the target platform. *) 13 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries eio_main lwt_eio lwt cohttp-eio opam-format opam-0install git-unix fmt.cli logs.cli fmt.tty logs.fmt)) 4 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/log.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "solver-service" ~doc:"Solver service" 2 | include (val Logs.src_log src : Logs.LOG) 3 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/main.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | module Request = Cohttp.Request 4 | module Server = Cohttp_eio.Server 5 | 6 | let parse_request req = 7 | let uri = Request.uri req in 8 | let path = 9 | uri 10 | |> Uri.path 11 | |> String.split_on_char '/' 12 | |> List.filter ((<>) "") 13 | in 14 | match Request.meth req, path with 15 | | `GET, [] -> `Main 16 | | `GET, ["solve"; commit; pkg] -> 17 | let pkg = OpamPackage.Name.of_string pkg in 18 | let commit = Git_unix.Store.Hash.of_hex commit in 19 | begin match Uri.get_query_param uri "ocaml_version" with 20 | | Some v -> 21 | let ocaml_version = (`Eq, OpamPackage.Version.of_string v) in 22 | `Solve { Solver.pkg; commit; ocaml_version } 23 | | None -> `Bad_request "Missing ocaml_version" 24 | end; 25 | | _, _ -> `Not_found 26 | 27 | let main ~socket opam_repo = 28 | Log.info (fun f -> f "Starting server..."); 29 | match Lwt_eio.run_lwt (fun () -> Git_unix.Store.v (Fpath.v opam_repo)) with 30 | | Error e -> Fmt.failwith "Can't open Git store %S: %a" opam_repo Git_unix.Store.pp_error e 31 | | Ok store -> 32 | let solver = Solver.create store in 33 | let callback _conn req _body = 34 | match parse_request req with 35 | | `Main -> Server.respond_string ~status:`OK ~body:"Usage: GET /solve/COMMIT/PKG?ocaml_version=VERSION" () 36 | | `Not_found -> Server.respond_string ~status:`Not_found ~body:"Not found" () 37 | | `Bad_request msg -> Server.respond_string ~status:`Bad_request ~body:msg () 38 | | `Solve request -> 39 | match Solver.solve solver request with 40 | | Ok selection -> 41 | let body = selection |> List.map OpamPackage.to_string |> String.concat " " in 42 | Server.respond_string ~status:`OK ~body () 43 | | Error msg -> 44 | Server.respond_string ~status:`OK ~body:msg () 45 | in 46 | let on_error ex = 47 | let bt = Printexc.get_raw_backtrace () in 48 | Log.warn (fun f -> f "%a" Fmt.exn_backtrace (ex, bt)) 49 | in 50 | Server.run ~on_error socket (Server.make ~callback ()) 51 | 52 | (* Command-line interface *) 53 | 54 | let setup_log style_renderer level = 55 | Fmt_tty.setup_std_outputs ?style_renderer (); 56 | Logs.set_level level; 57 | Logs.set_reporter (Logs_fmt.reporter ()); 58 | () 59 | 60 | open Cmdliner 61 | 62 | let setup_log = 63 | Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 64 | 65 | let port = 66 | Arg.value @@ 67 | Arg.opt Arg.int 8080 @@ 68 | Arg.info 69 | ~doc:"The port to listen on" 70 | ~docv:"PORT" 71 | ["port"] 72 | 73 | let opam_dir = 74 | Arg.required @@ 75 | Arg.pos 0 Arg.(some dir) None @@ 76 | Arg.info 77 | ~doc:"The path of an opam-repository clone" 78 | ~docv:"DIR" 79 | [] 80 | 81 | let () = 82 | let info = Cmd.info "solver service" in 83 | let main () port opam_repo = 84 | Eio_main.run @@ fun env -> 85 | Lwt_eio.with_event_loop ~debug:true ~clock:env#clock @@ fun _ -> 86 | Switch.run @@ fun sw -> 87 | let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in 88 | let socket = Eio.Net.listen ~sw ~backlog:5 ~reuse_addr:true env#net addr in 89 | traceln "Server listening on TCP port %d" port; 90 | main ~socket opam_repo 91 | in 92 | exit @@ Cmd.eval @@ Cmd.v info 93 | Term.(const main $ setup_log $ port $ opam_dir) 94 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/packages.ml: -------------------------------------------------------------------------------- 1 | open Lwt.Infix 2 | 3 | module Store = Git_unix.Store 4 | module Search = Git.Search.Make (Digestif.SHA1) (Store) 5 | 6 | (* The set of versions available for some package name. To speed things up, we 7 | parse the opam files lazily. 8 | 9 | Ideally we'd also load the files lazily, but [get_versions] can't return a 10 | Lwt promise, as the solver doesn't use Lwt, so we can't use Git_unix 11 | in the solver callback. *) 12 | type candidates = OpamFile.OPAM.t OpamPackage.Version.Map.t Eio.Lazy.t 13 | 14 | type t = candidates OpamPackage.Name.Map.t 15 | 16 | (* Load a Git directory tree from the store by hash. *) 17 | let read_dir store hash = 18 | Store.read store hash >|= function 19 | | Error e -> Fmt.failwith "Failed to read tree: %a" Store.pp_error e 20 | | Ok (Git.Value.Tree tree) -> Some tree 21 | | Ok _ -> None 22 | 23 | (* Load [pkg]'s opam file from its directory. *) 24 | let read_package store pkg hash = 25 | Search.find store hash (`Path [ "opam" ]) >>= function 26 | | None -> 27 | Fmt.failwith "opam file not found for %s" (OpamPackage.to_string pkg) 28 | | Some hash -> ( 29 | Store.read store hash >|= function 30 | | Ok (Git.Value.Blob blob) -> 31 | let blob = Store.Value.Blob.to_string blob in 32 | begin 33 | try OpamFile.OPAM.read_from_string blob 34 | with ex -> 35 | Fmt.failwith "Error parsing %s: %s" (OpamPackage.to_string pkg) (Printexc.to_string ex) 36 | end 37 | | _ -> 38 | Fmt.failwith "Bad Git object type for %s!" (OpamPackage.to_string pkg) 39 | ) 40 | 41 | (* Get a map of the versions inside [entry] (an entry under "packages") *) 42 | let read_versions store (entry : Store.Value.Tree.entry) = 43 | Lwt_eio.run_lwt @@ fun () -> 44 | read_dir store entry.node >>= function 45 | | None -> Lwt.return OpamPackage.Version.Map.empty 46 | | Some tree -> 47 | Store.Value.Tree.to_list tree 48 | |> Lwt_list.filter_map_p (fun (entry : Store.Value.Tree.entry) -> 49 | match OpamPackage.of_string_opt entry.name with 50 | | Some pkg -> 51 | read_package store pkg entry.node >|= fun opam -> 52 | Some (pkg.version, opam) 53 | | None -> 54 | Log.info (fun f -> f "Invalid package name %S" entry.name); 55 | Lwt.return None 56 | ) 57 | >|= OpamPackage.Version.Map.of_list 58 | 59 | let read_packages ~store tree = 60 | Store.Value.Tree.to_list tree 61 | |> Lwt_list.filter_map_s (fun (entry : Store.Value.Tree.entry) -> 62 | match OpamPackage.Name.of_string entry.name with 63 | | exception ex -> 64 | Log.warn (fun f -> f "Invalid package name %S: %a" entry.name Fmt.exn ex); 65 | Lwt.return_none 66 | | name -> 67 | let versions = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> read_versions store entry) in 68 | Lwt.return_some (name, versions) 69 | ) 70 | >|= OpamPackage.Name.Map.of_list 71 | 72 | let of_commit store commit : t = 73 | Lwt_eio.run_lwt @@ fun () -> 74 | Search.find store commit (`Commit (`Path [ "packages" ])) >>= function 75 | | None -> Fmt.failwith "Failed to find packages directory!" 76 | | Some tree_hash -> 77 | read_dir store tree_hash >>= function 78 | | None -> Fmt.failwith "'packages' is not a directory!" 79 | | Some tree -> read_packages ~store tree 80 | 81 | let get_versions (t:t) name = 82 | match OpamPackage.Name.Map.find_opt name t with 83 | | None -> OpamPackage.Version.Map.empty 84 | | Some versions -> Eio.Lazy.force versions 85 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/packages.mli: -------------------------------------------------------------------------------- 1 | (** Loads opam package metadata from an opam-respository commit. *) 2 | 3 | type t 4 | (** A particular commit of opam-repository. *) 5 | 6 | val of_commit : Git_unix.Store.t -> Git_unix.Store.Hash.t -> t 7 | (** [of_commit store hash] provides the packages at commit [hash] in [store]. *) 8 | 9 | val get_versions : t -> OpamPackage.Name.t -> OpamFile.OPAM.t OpamPackage.Version.Map.t 10 | (** [get_versions t pkg] returns all available versions of [pkg] in [t]. *) 11 | -------------------------------------------------------------------------------- /solutions/2-lwt-eio/solver.ml: -------------------------------------------------------------------------------- 1 | module Solver = Opam_0install.Solver.Make(Context) 2 | 3 | type t = { 4 | store : Git_unix.Store.t; 5 | mutable packages_cache : (Git_unix.Store.Hash.t * Packages.t Eio.Lazy.t) option; 6 | } 7 | 8 | type request = { 9 | pkg : OpamPackage.Name.t; 10 | commit : Git_unix.Store.Hash.t; 11 | ocaml_version : OpamFormula.version_constraint; 12 | } 13 | 14 | let std_env 15 | ?(ocaml_native=true) 16 | ?sys_ocaml_version 17 | ?opam_version 18 | ~arch ~os ~os_distribution ~os_family ~os_version 19 | () = 20 | function 21 | | "arch" -> Some (OpamTypes.S arch) 22 | | "os" -> Some (OpamTypes.S os) 23 | | "os-distribution" -> Some (OpamTypes.S os_distribution) 24 | | "os-version" -> Some (OpamTypes.S os_version) 25 | | "os-family" -> Some (OpamTypes.S os_family) 26 | | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 27 | | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v) 28 | | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 29 | | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 30 | | v -> 31 | OpamConsole.warning "Unknown variable %S" v; 32 | None 33 | 34 | let ocaml = OpamPackage.Name.of_string "ocaml" 35 | 36 | let packages t commit = 37 | match t.packages_cache with 38 | | Some (c, p) when Git_unix.Store.Hash.equal c commit -> Eio.Lazy.force p 39 | | _ -> 40 | let p = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> 41 | Log.info (fun f -> f "Loading packages..."); 42 | let pkgs = Packages.of_commit t.store commit in 43 | Log.info (fun f -> f "Loaded packages"); 44 | pkgs 45 | ) in 46 | t.packages_cache <- Some (commit, p); 47 | Eio.Lazy.force p 48 | 49 | let solve t { pkg; commit; ocaml_version } = 50 | let env = std_env () 51 | ~os:"linux" 52 | ~os_family:"debian" 53 | ~os_distribution:"debian" 54 | ~os_version:"12" 55 | ~arch:"x86_64" 56 | in 57 | let packages = packages t commit in 58 | let constraints = OpamPackage.Name.Map.singleton ocaml ocaml_version in 59 | let ctx = Context.create ~env ~constraints packages in 60 | match Solver.solve ctx [pkg] with 61 | | Ok x -> Ok (Solver.packages_of_result x) 62 | | Error e -> Error (Solver.diagnostics e) 63 | | exception ex -> Fmt.epr "Solver: %a@." Fmt.exn ex; raise ex 64 | 65 | let create store = { store; packages_cache = None } 66 | -------------------------------------------------------------------------------- /solutions/3-eio/context.ml: -------------------------------------------------------------------------------- 1 | (* This module is used by the solver to get the candiate versions of each packages. *) 2 | 3 | type rejection = 4 | | UserConstraint of OpamFormula.atom 5 | | Unavailable 6 | 7 | type t = { 8 | env : string -> OpamVariable.variable_contents option; 9 | packages : Packages.t; 10 | constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 11 | } 12 | 13 | let user_restrictions t name = 14 | OpamPackage.Name.Map.find_opt name t.constraints 15 | 16 | let dev = OpamPackage.Version.of_string "dev" 17 | 18 | let env t pkg v = 19 | if List.mem v OpamPackageVar.predefined_depends_variables then None 20 | else match OpamVariable.Full.to_string v with 21 | | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg))) 22 | | x -> t.env x 23 | 24 | let filter_deps t pkg f = 25 | let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in 26 | f 27 | |> OpamFilter.partial_filter_formula (env t pkg) 28 | |> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false ~dev ~default:false 29 | 30 | let candidates t name = 31 | let user_constraints = user_restrictions t name in 32 | Packages.get_versions t.packages name 33 | |> OpamPackage.Version.Map.bindings 34 | |> List.rev 35 | |> List.map (fun (v, opam) -> 36 | match user_constraints with 37 | | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> 38 | v, Error (UserConstraint (name, Some test)) 39 | | _ -> 40 | let pkg = OpamPackage.create name v in 41 | let available = OpamFile.OPAM.available opam in 42 | match OpamFilter.eval_to_bool ~default:false (env t pkg) available with 43 | | true -> v, Ok opam 44 | | false -> v, Error Unavailable 45 | ) 46 | 47 | let pp_rejection f = function 48 | | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x) 49 | | Unavailable -> Fmt.string f "Availability condition not satisfied" 50 | 51 | let create ~constraints ~env packages = 52 | { env; packages; constraints } 53 | -------------------------------------------------------------------------------- /solutions/3-eio/context.mli: -------------------------------------------------------------------------------- 1 | include Opam_0install.S.CONTEXT 2 | 3 | val create : 4 | constraints:OpamFormula.version_constraint OpamTypes.name_map -> 5 | env:(string -> OpamVariable.variable_contents option) -> 6 | Packages.t -> 7 | t 8 | (** [create ~constraints ~env packages] loads information about candidate packages from [packages], 9 | sorts and filters them, and provides them to the solver. 10 | 11 | @param constraints Allows filtering out candidates before they get to the solver. 12 | @param env Details about the target platform. *) 13 | -------------------------------------------------------------------------------- /solutions/3-eio/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries eio_main cohttp-eio opam-format opam-0install git-eio fmt.cli logs.cli fmt.tty logs.fmt)) 4 | -------------------------------------------------------------------------------- /solutions/3-eio/log.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "solver-service" ~doc:"Solver service" 2 | include (val Logs.src_log src : Logs.LOG) 3 | -------------------------------------------------------------------------------- /solutions/3-eio/main.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | module Request = Cohttp.Request 4 | module Server = Cohttp_eio.Server 5 | 6 | let parse_request req = 7 | let uri = Request.uri req in 8 | let path = 9 | uri 10 | |> Uri.path 11 | |> String.split_on_char '/' 12 | |> List.filter ((<>) "") 13 | in 14 | match Request.meth req, path with 15 | | `GET, [] -> `Main 16 | | `GET, ["solve"; commit; pkg] -> 17 | let pkg = OpamPackage.Name.of_string pkg in 18 | let commit = Git_eio.Store.Hash.of_hex commit in 19 | begin match Uri.get_query_param uri "ocaml_version" with 20 | | Some v -> 21 | let ocaml_version = (`Eq, OpamPackage.Version.of_string v) in 22 | `Solve { Solver.pkg; commit; ocaml_version } 23 | | None -> `Bad_request "Missing ocaml_version" 24 | end; 25 | | _, _ -> `Not_found 26 | 27 | let main ~socket opam_repo = 28 | Log.info (fun f -> f "Starting server..."); 29 | match Git_eio.Store.v opam_repo with 30 | | Error e -> Fmt.failwith "Can't open Git store %a: %a" Eio.Path.pp opam_repo Git_eio.Store.pp_error e 31 | | Ok store -> 32 | let solver = Solver.create store in 33 | let callback _conn req _body = 34 | match parse_request req with 35 | | `Main -> Server.respond_string ~status:`OK ~body:"Usage: GET /solve/COMMIT/PKG?ocaml_version=VERSION" () 36 | | `Not_found -> Server.respond_string ~status:`Not_found ~body:"Not found" () 37 | | `Bad_request msg -> Server.respond_string ~status:`Bad_request ~body:msg () 38 | | `Solve request -> 39 | match Solver.solve solver request with 40 | | Ok selection -> 41 | let body = selection |> List.map OpamPackage.to_string |> String.concat " " in 42 | Server.respond_string ~status:`OK ~body () 43 | | Error msg -> 44 | Server.respond_string ~status:`OK ~body:msg () 45 | in 46 | let on_error ex = 47 | let bt = Printexc.get_raw_backtrace () in 48 | Log.warn (fun f -> f "%a" Fmt.exn_backtrace (ex, bt)) 49 | in 50 | Server.run ~on_error socket (Server.make ~callback ()) 51 | 52 | (* Command-line interface *) 53 | 54 | let setup_log style_renderer level = 55 | Fmt_tty.setup_std_outputs ?style_renderer (); 56 | Logs.set_level level; 57 | Logs.set_reporter (Logs_fmt.reporter ()); 58 | () 59 | 60 | open Cmdliner 61 | 62 | let setup_log = 63 | Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 64 | 65 | let port = 66 | Arg.value @@ 67 | Arg.opt Arg.int 8080 @@ 68 | Arg.info 69 | ~doc:"The port to listen on" 70 | ~docv:"PORT" 71 | ["port"] 72 | 73 | let opam_dir = 74 | Arg.required @@ 75 | Arg.pos 0 Arg.(some dir) None @@ 76 | Arg.info 77 | ~doc:"The path of an opam-repository clone" 78 | ~docv:"DIR" 79 | [] 80 | 81 | let ( / ) = Eio.Path.( / ) 82 | 83 | let () = 84 | let info = Cmd.info "solver service" in 85 | let main () port opam_repo = 86 | Eio_main.run @@ fun env -> 87 | Switch.run @@ fun sw -> 88 | let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in 89 | let socket = Eio.Net.listen ~sw ~backlog:5 ~reuse_addr:true env#net addr in 90 | traceln "Server listening on TCP port %d" port; 91 | Eio.Path.with_open_dir (env#fs / opam_repo) @@ fun opam_repo -> 92 | main ~socket opam_repo 93 | in 94 | exit @@ Cmd.eval @@ Cmd.v info 95 | Term.(const main $ setup_log $ port $ opam_dir) 96 | -------------------------------------------------------------------------------- /solutions/3-eio/packages.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | module Store = Git_eio.Store 4 | module Search = Git_eio.Search.Make (Digestif.SHA1) (Store) 5 | 6 | type candidates = OpamFile.OPAM.t OpamPackage.Version.Map.t Eio.Lazy.t 7 | 8 | type t = candidates OpamPackage.Name.Map.t 9 | 10 | (* Load a Git directory tree from the store by hash. *) 11 | let read_dir store hash = 12 | match Store.read store hash with 13 | | Error e -> Fmt.failwith "Failed to read tree: %a" Store.pp_error e 14 | | Ok (Git_eio.Value.Tree tree) -> Some tree 15 | | Ok _ -> None 16 | 17 | (* Load [pkg]'s opam file from its directory. *) 18 | let read_package store pkg hash = 19 | match Search.find store hash (`Path [ "opam" ]) with 20 | | None -> 21 | Fmt.failwith "opam file not found for %s" (OpamPackage.to_string pkg) 22 | | Some hash -> ( 23 | match Store.read store hash with 24 | | Ok (Git_eio.Value.Blob blob) -> 25 | let blob = Store.Value.Blob.to_string blob in 26 | begin 27 | try OpamFile.OPAM.read_from_string blob 28 | with ex -> 29 | Fmt.failwith "Error parsing %s: %s" (OpamPackage.to_string pkg) (Printexc.to_string ex) 30 | end 31 | | _ -> 32 | Fmt.failwith "Bad Git object type for %s!" (OpamPackage.to_string pkg) 33 | ) 34 | 35 | (* Get a map of the versions inside [entry] (an entry under "packages") *) 36 | let read_versions store (entry : Store.Value.Tree.entry) = 37 | match read_dir store entry.node with 38 | | None -> OpamPackage.Version.Map.empty 39 | | Some tree -> 40 | Store.Value.Tree.to_list tree 41 | |> Fiber.List.filter_map (fun (entry : Store.Value.Tree.entry) -> 42 | match OpamPackage.of_string_opt entry.name with 43 | | Some pkg -> 44 | let opam = read_package store pkg entry.node in 45 | Some (pkg.version, opam) 46 | | None -> 47 | Log.info (fun f -> f "Invalid package name %S" entry.name); 48 | None 49 | ) 50 | |> OpamPackage.Version.Map.of_list 51 | 52 | let read_packages ~store tree = 53 | Store.Value.Tree.to_list tree 54 | |> List.filter_map (fun (entry : Store.Value.Tree.entry) -> 55 | match OpamPackage.Name.of_string entry.name with 56 | | exception ex -> 57 | Log.warn (fun f -> f "Invalid package name %S: %a" entry.name Fmt.exn ex); 58 | None 59 | | name -> 60 | Some (name, Eio.Lazy.from_fun ~cancel:`Restart (fun () -> read_versions store entry)) 61 | ) 62 | |> OpamPackage.Name.Map.of_list 63 | 64 | let of_commit store commit : t = 65 | match Search.find store commit (`Commit (`Path [ "packages" ])) with 66 | | None -> Fmt.failwith "Failed to find packages directory!" 67 | | Some tree_hash -> 68 | match read_dir store tree_hash with 69 | | None -> Fmt.failwith "'packages' is not a directory!" 70 | | Some tree -> read_packages ~store tree 71 | 72 | let get_versions (t:t) name = 73 | match OpamPackage.Name.Map.find_opt name t with 74 | | None -> OpamPackage.Version.Map.empty 75 | | Some versions -> Eio.Lazy.force versions 76 | -------------------------------------------------------------------------------- /solutions/3-eio/packages.mli: -------------------------------------------------------------------------------- 1 | (** Loads opam package metadata from an opam-respository commit. *) 2 | 3 | type t 4 | (** A particular commit of opam-repository. *) 5 | 6 | val of_commit : Git_eio.Store.t -> Git_eio.Store.Hash.t -> t 7 | (** [of_commit store hash] provides the packages at commit [hash] in [store]. *) 8 | 9 | val get_versions : t -> OpamPackage.Name.t -> OpamFile.OPAM.t OpamPackage.Version.Map.t 10 | (** [get_versions t pkg] returns all available versions of [pkg] in [t]. *) 11 | -------------------------------------------------------------------------------- /solutions/3-eio/solver.ml: -------------------------------------------------------------------------------- 1 | module Solver = Opam_0install.Solver.Make(Context) 2 | 3 | type t = { 4 | store : Git_eio.Store.t; 5 | mutable packages_cache : (Git_eio.Store.Hash.t * Packages.t Eio.Lazy.t) option; 6 | } 7 | 8 | type request = { 9 | pkg : OpamPackage.Name.t; 10 | commit : Git_eio.Store.Hash.t; 11 | ocaml_version : OpamFormula.version_constraint; 12 | } 13 | 14 | let std_env 15 | ?(ocaml_native=true) 16 | ?sys_ocaml_version 17 | ?opam_version 18 | ~arch ~os ~os_distribution ~os_family ~os_version 19 | () = 20 | function 21 | | "arch" -> Some (OpamTypes.S arch) 22 | | "os" -> Some (OpamTypes.S os) 23 | | "os-distribution" -> Some (OpamTypes.S os_distribution) 24 | | "os-version" -> Some (OpamTypes.S os_version) 25 | | "os-family" -> Some (OpamTypes.S os_family) 26 | | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 27 | | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v) 28 | | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 29 | | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 30 | | v -> 31 | OpamConsole.warning "Unknown variable %S" v; 32 | None 33 | 34 | let ocaml = OpamPackage.Name.of_string "ocaml" 35 | 36 | let packages t commit = 37 | match t.packages_cache with 38 | | Some (c, p) when Git_eio.Store.Hash.equal c commit -> Eio.Lazy.force p 39 | | _ -> 40 | let p = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> 41 | Log.info (fun f -> f "Loading packages..."); 42 | let pkgs = Packages.of_commit t.store commit in 43 | Log.info (fun f -> f "Loaded packages"); 44 | pkgs 45 | ) in 46 | t.packages_cache <- Some (commit, p); 47 | Eio.Lazy.force p 48 | 49 | let solve t { pkg; commit; ocaml_version } = 50 | let env = std_env () 51 | ~os:"linux" 52 | ~os_family:"debian" 53 | ~os_distribution:"debian" 54 | ~os_version:"12" 55 | ~arch:"x86_64" 56 | in 57 | let packages = packages t commit in 58 | let constraints = OpamPackage.Name.Map.singleton ocaml ocaml_version in 59 | let ctx = Context.create ~env ~constraints packages in 60 | match Solver.solve ctx [pkg] with 61 | | Ok x -> Ok (Solver.packages_of_result x) 62 | | Error e -> Error (Solver.diagnostics e) 63 | | exception ex -> Fmt.epr "Solver: %a@." Fmt.exn ex; raise ex 64 | 65 | let create store = { store; packages_cache = None } 66 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/context.ml: -------------------------------------------------------------------------------- 1 | (* This module is used by the solver to get the candiate versions of each packages. *) 2 | 3 | type rejection = 4 | | UserConstraint of OpamFormula.atom 5 | | Unavailable 6 | 7 | type t = { 8 | env : string -> OpamVariable.variable_contents option; 9 | packages : Packages.t; 10 | constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *) 11 | } 12 | 13 | let user_restrictions t name = 14 | OpamPackage.Name.Map.find_opt name t.constraints 15 | 16 | let dev = OpamPackage.Version.of_string "dev" 17 | 18 | let env t pkg v = 19 | if List.mem v OpamPackageVar.predefined_depends_variables then None 20 | else match OpamVariable.Full.to_string v with 21 | | "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg))) 22 | | x -> t.env x 23 | 24 | let filter_deps t pkg f = 25 | Eio.Mutex.use_ro Opam_lock.v @@ fun () -> 26 | let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in 27 | f 28 | |> OpamFilter.partial_filter_formula (env t pkg) 29 | |> OpamFilter.filter_deps ~build:true ~post:true ~test:false ~doc:false ~dev ~default:false 30 | 31 | let candidates t name = 32 | let user_constraints = user_restrictions t name in 33 | Packages.get_versions t.packages name 34 | |> OpamPackage.Version.Map.bindings 35 | |> List.rev 36 | |> List.map (fun (v, opam) -> 37 | match user_constraints with 38 | | Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) -> 39 | v, Error (UserConstraint (name, Some test)) 40 | | _ -> 41 | let pkg = OpamPackage.create name v in 42 | let available = OpamFile.OPAM.available opam in 43 | match OpamFilter.eval_to_bool ~default:false (env t pkg) available with 44 | | true -> v, Ok opam 45 | | false -> v, Error Unavailable 46 | ) 47 | 48 | let pp_rejection f = function 49 | | UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x) 50 | | Unavailable -> Fmt.string f "Availability condition not satisfied" 51 | 52 | let create ~constraints ~env packages = 53 | { env; packages; constraints } 54 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/context.mli: -------------------------------------------------------------------------------- 1 | include Opam_0install.S.CONTEXT 2 | 3 | val create : 4 | constraints:OpamFormula.version_constraint OpamTypes.name_map -> 5 | env:(string -> OpamVariable.variable_contents option) -> 6 | Packages.t -> 7 | t 8 | (** [create ~constraints ~env packages] loads information about candidate packages from [packages], 9 | sorts and filters them, and provides them to the solver. 10 | 11 | @param constraints Allows filtering out candidates before they get to the solver. 12 | @param env Details about the target platform. *) 13 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name main) 3 | (libraries eio_main cohttp-eio opam-format opam-0install git-eio fmt.cli logs.cli fmt.tty logs.fmt logs.threaded)) 4 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/log.ml: -------------------------------------------------------------------------------- 1 | let src = Logs.Src.create "solver-service" ~doc:"Solver service" 2 | include (val Logs.src_log src : Logs.LOG) 3 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/main.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | open Cohttp 3 | open Cohttp_eio 4 | 5 | let parse_request req = 6 | let uri = Request.uri req in 7 | let path = 8 | uri 9 | |> Uri.path 10 | |> String.split_on_char '/' 11 | |> List.filter ((<>) "") 12 | in 13 | match Request.meth req, path with 14 | | `GET, [] -> `Main 15 | | `GET, ["solve"; commit; pkg] -> 16 | let pkg = OpamPackage.Name.of_string pkg in 17 | let commit = Git_eio.Store.Hash.of_hex commit in 18 | begin match Uri.get_query_param uri "ocaml_version" with 19 | | Some v -> 20 | let ocaml_version = (`Eq, OpamPackage.Version.of_string v) in 21 | `Solve { Solver.pkg; commit; ocaml_version } 22 | | None -> `Bad_request "Missing ocaml_version" 23 | end; 24 | | _, _ -> `Not_found 25 | 26 | let main ~pool ~socket opam_repo = 27 | Log.info (fun f -> f "Starting server..."); 28 | match Git_eio.Store.v opam_repo with 29 | | Error e -> Fmt.failwith "Can't open Git store %a: %a" Eio.Path.pp opam_repo Git_eio.Store.pp_error e 30 | | Ok store -> 31 | let solver = Solver.create ~pool store in 32 | let callback _conn req _body = 33 | match parse_request req with 34 | | `Main -> Server.respond_string ~status:`OK ~body:"Usage: GET /solve/COMMIT/PKG?ocaml_version=VERSION" () 35 | | `Not_found -> Server.respond_string ~status:`Not_found ~body:"Not found" () 36 | | `Bad_request msg -> Server.respond_string ~status:`Bad_request ~body:msg () 37 | | `Solve request -> 38 | match Solver.solve solver request with 39 | | Ok selection -> 40 | let body = selection |> List.map OpamPackage.to_string |> String.concat " " in 41 | Server.respond_string ~status:`OK ~body () 42 | | Error msg -> 43 | Server.respond_string ~status:`OK ~body:msg () 44 | in 45 | let on_error ex = 46 | let bt = Printexc.get_raw_backtrace () in 47 | Log.warn (fun f -> f "%a" Fmt.exn_backtrace (ex, bt)) 48 | in 49 | Server.run ~on_error socket (Server.make ~callback ()) 50 | 51 | (* Command-line interface *) 52 | 53 | let setup_log style_renderer level = 54 | Fmt_tty.setup_std_outputs ?style_renderer (); 55 | Logs.set_level level; 56 | Logs.set_reporter (Logs_fmt.reporter ()); 57 | () 58 | 59 | open Cmdliner 60 | 61 | let setup_log = 62 | Term.(const setup_log $ Fmt_cli.style_renderer () $ Logs_cli.level ()) 63 | 64 | let port = 65 | Arg.value @@ 66 | Arg.opt Arg.int 8080 @@ 67 | Arg.info 68 | ~doc:"The port to listen on" 69 | ~docv:"PORT" 70 | ["port"] 71 | 72 | let opam_dir = 73 | Arg.required @@ 74 | Arg.pos 0 Arg.(some dir) None @@ 75 | Arg.info 76 | ~doc:"The path of an opam-repository clone" 77 | ~docv:"DIR" 78 | [] 79 | 80 | let ( / ) = Eio.Path.( / ) 81 | 82 | let () = 83 | Logs_threaded.enable (); 84 | let info = Cmd.info "solver service" in 85 | let main () port opam_repo = 86 | Eio_main.run @@ fun env -> 87 | Switch.run @@ fun sw -> 88 | let domain_mgr = env#domain_mgr in 89 | let pool = Worker_pool.create ~sw ~domain_mgr 3 in 90 | let addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, port) in 91 | let socket = Eio.Net.listen ~sw ~backlog:5 ~reuse_addr:true env#net addr in 92 | traceln "Server listening on TCP port %d" port; 93 | Eio.Path.with_open_dir (env#fs / opam_repo) @@ fun opam_repo -> 94 | main ~pool ~socket opam_repo 95 | in 96 | exit @@ Cmd.eval @@ Cmd.v info 97 | Term.(const main $ setup_log $ port $ opam_dir) 98 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/opam_lock.ml: -------------------------------------------------------------------------------- 1 | let v = Eio.Mutex.create () 2 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/packages.ml: -------------------------------------------------------------------------------- 1 | open! Eio.Std 2 | 3 | module Store = struct 4 | module Store_unsafe = Git_eio.Store 5 | module Search_unsafe = Git_eio.Search.Make (Digestif.SHA1) (Store_unsafe) 6 | module Value = Store_unsafe.Value 7 | 8 | let lock = Eio.Mutex.create () 9 | 10 | let find store hash path = 11 | Eio.Mutex.use_ro lock @@ fun () -> 12 | Search_unsafe.find store hash path 13 | 14 | let read store hash = 15 | Eio.Mutex.use_ro lock @@ fun () -> 16 | Store_unsafe.read store hash 17 | 18 | let pp_error = Store_unsafe.pp_error 19 | end 20 | 21 | type candidates = OpamFile.OPAM.t OpamPackage.Version.Map.t Eio.Lazy.t 22 | 23 | type t = candidates OpamPackage.Name.Map.t 24 | 25 | (* Load a Git directory tree from the store by hash. *) 26 | let read_dir store hash = 27 | match Store.read store hash with 28 | | Error e -> Fmt.failwith "Failed to read tree: %a" Store.pp_error e 29 | | Ok (Git_eio.Value.Tree tree) -> Some tree 30 | | Ok _ -> None 31 | 32 | (* Load [pkg]'s opam file from its directory. *) 33 | let read_package store pkg hash = 34 | match Store.find store hash (`Path [ "opam" ]) with 35 | | None -> 36 | Fmt.failwith "opam file not found for %s" (OpamPackage.to_string pkg) 37 | | Some hash -> ( 38 | match Store.read store hash with 39 | | Ok (Git_eio.Value.Blob blob) -> 40 | let blob = Store.Value.Blob.to_string blob in 41 | begin 42 | try 43 | Eio.Mutex.use_ro Opam_lock.v @@ fun () -> 44 | OpamFile.OPAM.read_from_string blob 45 | with ex -> 46 | Fmt.failwith "Error parsing %s: %s" (OpamPackage.to_string pkg) (Printexc.to_string ex) 47 | end 48 | | _ -> 49 | Fmt.failwith "Bad Git object type for %s!" (OpamPackage.to_string pkg) 50 | ) 51 | 52 | (* Get a map of the versions inside [entry] (an entry under "packages") *) 53 | let read_versions store (entry : Store.Value.Tree.entry) = 54 | match read_dir store entry.node with 55 | | None -> OpamPackage.Version.Map.empty 56 | | Some tree -> 57 | Store.Value.Tree.to_list tree 58 | |> Fiber.List.filter_map (fun (entry : Store.Value.Tree.entry) -> 59 | match OpamPackage.of_string_opt entry.name with 60 | | Some pkg -> 61 | let opam = read_package store pkg entry.node in 62 | Some (pkg.version, opam) 63 | | None -> 64 | Log.info (fun f -> f "Invalid package name %S" entry.name); 65 | None 66 | ) 67 | |> OpamPackage.Version.Map.of_list 68 | 69 | let read_packages ~store tree = 70 | Store.Value.Tree.to_list tree 71 | |> List.filter_map (fun (entry : Store.Value.Tree.entry) -> 72 | match OpamPackage.Name.of_string entry.name with 73 | | exception ex -> 74 | Log.warn (fun f -> f "Invalid package name %S: %a" entry.name Fmt.exn ex); 75 | None 76 | | name -> 77 | Some (name, Eio.Lazy.from_fun ~cancel:`Restart (fun () -> read_versions store entry)) 78 | ) 79 | |> OpamPackage.Name.Map.of_list 80 | 81 | let of_commit store commit : t = 82 | match Store.find store commit (`Commit (`Path [ "packages" ])) with 83 | | None -> Fmt.failwith "Failed to find packages directory!" 84 | | Some tree_hash -> 85 | match read_dir store tree_hash with 86 | | None -> Fmt.failwith "'packages' is not a directory!" 87 | | Some tree -> read_packages ~store tree 88 | 89 | let get_versions (t:t) name = 90 | match OpamPackage.Name.Map.find_opt name t with 91 | | None -> OpamPackage.Version.Map.empty 92 | | Some versions -> Eio.Lazy.force versions 93 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/packages.mli: -------------------------------------------------------------------------------- 1 | (** Loads opam package metadata from an opam-respository commit. *) 2 | 3 | type t 4 | (** A particular commit of opam-repository. *) 5 | 6 | val of_commit : Git_eio.Store.t -> Git_eio.Store.Hash.t -> t 7 | (** [of_commit store hash] provides the packages at commit [hash] in [store]. *) 8 | 9 | val get_versions : t -> OpamPackage.Name.t -> OpamFile.OPAM.t OpamPackage.Version.Map.t 10 | (** [get_versions t pkg] returns all available versions of [pkg] in [t]. *) 11 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/solver.ml: -------------------------------------------------------------------------------- 1 | module Solver = Opam_0install.Solver.Make(Context) 2 | 3 | type t = { 4 | store : Git_eio.Store.t; 5 | pool : Worker_pool.t; 6 | mutable packages_cache : (Git_eio.Store.Hash.t * Packages.t Eio.Lazy.t) option; 7 | } 8 | 9 | type request = { 10 | pkg : OpamPackage.Name.t; 11 | commit : Git_eio.Store.Hash.t; 12 | ocaml_version : OpamFormula.version_constraint; 13 | } 14 | 15 | let std_env 16 | ?(ocaml_native=true) 17 | ?sys_ocaml_version 18 | ?opam_version 19 | ~arch ~os ~os_distribution ~os_family ~os_version 20 | () = 21 | function 22 | | "arch" -> Some (OpamTypes.S arch) 23 | | "os" -> Some (OpamTypes.S os) 24 | | "os-distribution" -> Some (OpamTypes.S os_distribution) 25 | | "os-version" -> Some (OpamTypes.S os_version) 26 | | "os-family" -> Some (OpamTypes.S os_family) 27 | | "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version)) 28 | | "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v) 29 | | "ocaml:native" -> Some (OpamTypes.B ocaml_native) 30 | | "enable-ocaml-beta-repository" -> None (* Fake variable? *) 31 | | v -> 32 | OpamConsole.warning "Unknown variable %S" v; 33 | None 34 | 35 | let ocaml = OpamPackage.Name.of_string "ocaml" 36 | 37 | let packages t commit = 38 | match t.packages_cache with 39 | | Some (c, p) when Git_eio.Store.Hash.equal c commit -> Eio.Lazy.force p 40 | | _ -> 41 | let p = Eio.Lazy.from_fun ~cancel:`Restart (fun () -> 42 | Log.info (fun f -> f "Loading packages..."); 43 | let pkgs = Packages.of_commit t.store commit in 44 | Log.info (fun f -> f "Loaded packages"); 45 | pkgs 46 | ) in 47 | t.packages_cache <- Some (commit, p); 48 | Eio.Lazy.force p 49 | 50 | let solve t { pkg; commit; ocaml_version } = 51 | let env = std_env () 52 | ~os:"linux" 53 | ~os_family:"debian" 54 | ~os_distribution:"debian" 55 | ~os_version:"12" 56 | ~arch:"x86_64" 57 | in 58 | let packages = packages t commit in 59 | let constraints = OpamPackage.Name.Map.singleton ocaml ocaml_version in 60 | let ctx = Context.create ~env ~constraints packages in 61 | Worker_pool.submit t.pool @@ fun () -> 62 | match Solver.solve ctx [pkg] with 63 | | Ok x -> Ok (Solver.packages_of_result x) 64 | | Error e -> Error (Solver.diagnostics e) 65 | | exception ex -> Fmt.epr "Solver: %a@." Fmt.exn ex; raise ex 66 | 67 | let create ~pool store = { pool; store; packages_cache = None } 68 | -------------------------------------------------------------------------------- /solutions/4-eio-multicore/worker_pool.ml: -------------------------------------------------------------------------------- 1 | open Eio.Std 2 | 3 | type job = Job : (unit -> 'a) * ('a, exn) result Promise.u -> job 4 | 5 | type t = job Eio.Stream.t 6 | 7 | let submit (t:t) fn = 8 | let p, r = Promise.create () in 9 | Eio.Stream.add t (Job (fn, r)); 10 | Promise.await_exn p 11 | 12 | let rec run_worker (t:t) = 13 | let Job (fn, reply) = Eio.Stream.take t in 14 | let id = (Domain.self () :> int) in 15 | traceln "Domain %d: running job..." id; 16 | begin 17 | match fn () with 18 | | v -> Promise.resolve_ok reply v 19 | | exception ex -> Promise.resolve_error reply ex 20 | end; 21 | traceln "Domain %d: finished" id; 22 | run_worker t 23 | 24 | let create ~sw ~domain_mgr n : t = 25 | let t = Eio.Stream.create 0 in 26 | for _ = 1 to n do 27 | Fiber.fork_daemon ~sw (fun () -> Eio.Domain_manager.run domain_mgr (fun () -> run_worker t)) 28 | done; 29 | t 30 | -------------------------------------------------------------------------------- /tutorial.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | maintainer: "No maintainer" 3 | authors: ["Thomas Leonard"] 4 | homepage: "No homepage" 5 | bug-reports: "No issue tracker" 6 | synopsis: "Lwt to Eio tutorial" 7 | depends: [ 8 | "dune" {>= "3.9"} 9 | "ocaml" {>= "5.0.0"} 10 | "eio_main" {>= "0.12"} 11 | "lwt_eio" {>= "0.5"} 12 | "logs" {>= "0.7.0"} 13 | "fmt" {>= "0.9.0"} 14 | "cmdliner" {>= "1.2.0"} 15 | "opam-0install" {>= "0.4.3"} 16 | 17 | # cohttp 18 | "uri-sexp" 19 | "re" {>= "1.9.0"} 20 | "uri" {>= "2.0.0"} 21 | "sexplib0" 22 | "ppx_sexp_conv" {>= "v0.13.0"} 23 | "stringext" 24 | "base64" {>= "3.1.0"} 25 | 26 | # cohttp-lwt 27 | "lwt" {>= "2.5.0"} 28 | "logs" 29 | 30 | # conduit-lwt-unix 31 | "conduit-lwt" {>= "5.0.0"} 32 | "conduit-lwt-unix" {>= "5.0.0"} 33 | "magic-mime" 34 | 35 | # "cohttp-eio" 36 | 37 | "git-unix" 38 | ] 39 | build: [ 40 | [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} "@doc" {with-doc} ] 41 | ] 42 | --------------------------------------------------------------------------------