From d5b5038c29e69451c2e60336b4e268cf49f46664 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 10:58:11 +0100 Subject: [PATCH 1/7] Add endpoint for getting the latest stable release Signed-off-by: Marek Kubica --- bin/main.ml | 24 +----------------------- bin/server.ml | 23 +++++++++++++++++++---- lib/metadata.ml | 22 ++++++++++++++++++++++ 3 files changed, 42 insertions(+), 27 deletions(-) diff --git a/bin/main.ml b/bin/main.ml index f75ba17..b73f15b 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -110,35 +110,13 @@ module Sync = struct let cmd = Cmd.v info term end -let find_latest_stable bundles = - bundles - |> List.filter_map (fun (b : Metadata.Bundle.t) -> - match b.tag with - | None -> None - | Some tag -> - (match Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z) with - | None -> None - | Some tup -> Some (tup, b))) - |> List.sort (fun ((maj, min, patch), _) ((maj', min', patch'), _) -> - (* reverse sort, biggest first *) - match Int.compare maj' maj with - | 0 -> - (match Int.compare min' min with - | 0 -> Int.compare patch' patch - | otherwise -> otherwise) - | otherwise -> otherwise) - |> function - | [] -> None - | (_, bundle) :: _ -> Some bundle -;; - module Http = struct let serve dev (module Config : Config.Configuration) port = let title = "Dune Nightly" in let base_url = Config.Server.url in let bundles = Metadata.import_from_json Config.Path.metadata in let latest_release = - match find_latest_stable bundles with + match Metadata.Bundle.newest_tagged bundles with | None -> "" | Some bundle -> (* guaranteed to exist at this point *) diff --git a/bin/server.ml b/bin/server.ml index 9f23df7..0c46b1c 100644 --- a/bin/server.ml +++ b/bin/server.ml @@ -1,3 +1,7 @@ +type release = + | Latest + | Specific of string + let cache_middleware ~dev next_handler request = let open Lwt.Infix in if (not dev) && Dream.target request |> String.starts_with ~prefix:"/static" @@ -16,9 +20,16 @@ let reload_script_middleware ~dev inner_handler request = let matching_bundle ~base_url bundles ~target ~tag request = let module Bundle = Sandworm.Metadata.Bundle in let bundle = - List.find_opt - (fun candidate -> Bundle.matches_criteria ~tag ~target candidate) - bundles + match tag with + | Some Latest -> Bundle.newest_tagged bundles + | Some (Specific version) -> + List.find_opt + (fun candidate -> Bundle.matches_criteria ~tag:(Some version) ~target candidate) + bundles + | None as tag -> + List.find_opt + (fun candidate -> Bundle.matches_criteria ~tag ~target candidate) + bundles in match bundle with | None -> Dream.respond ~status:`Not_Found "No such release" @@ -36,7 +47,11 @@ let latest_route_from_targets ~base_url bundles request = let stable_release ~base_url bundles request = let module Target = Sandworm.Metadata.Target in - let release = Dream.param request "release" in + let release = + match Dream.param request "release" with + | "latest" -> Latest + | version -> Specific version + in let target = Dream.param request "target" in match Target.of_string target with | None -> Dream.respond ~status:`Not_Found "Invalid target" diff --git a/lib/metadata.ml b/lib/metadata.ml index dbc0b87..dafbc11 100644 --- a/lib/metadata.ml +++ b/lib/metadata.ml @@ -90,6 +90,28 @@ module Bundle = struct | Some t -> List.mem target t.targets ;; + let newest_tagged bundles = + bundles + |> List.filter_map (fun bundle -> + match bundle.tag with + | None -> None + | Some tag -> + (match Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z) with + | None -> None + | Some tup -> Some (tup, bundle))) + |> List.sort (fun ((maj, min, patch), _) ((maj', min', patch'), _) -> + (* reverse sort, biggest first *) + match Int.compare maj' maj with + | 0 -> + (match Int.compare min' min with + | 0 -> Int.compare patch' patch + | otherwise -> otherwise) + | otherwise -> otherwise) + |> function + | [] -> None + | (_, bundle) :: _ -> Some bundle + ;; + let get_date_string_from ?prefix t = let y, m, d = t.date in let date = Format.sprintf "%d-%02d-%02d" y m d in From 9a98306314ad941de0d33719414adcb7eae9e218 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 10:59:24 +0100 Subject: [PATCH 2/7] No more silly-con Signed-off-by: Marek Kubica --- lib/metadata.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/metadata.ml b/lib/metadata.ml index dafbc11..f1d3072 100644 --- a/lib/metadata.ml +++ b/lib/metadata.ml @@ -25,7 +25,7 @@ module Target = struct ;; let to_description = function - | Aarch64_apple_darwin -> "macOS 11 or later for Apple Sillicon processors" + | Aarch64_apple_darwin -> "macOS 11 or later for Apple silicon processors" | X86_64_apple_darwin -> "macOS 11 or later for Intel processors" | X86_64_unknown_linux_musl -> "Linux for Intel 64-bit processors" ;; From ec6b518c87b26812a4a3df74e130d8779f0f1178 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 11:26:19 +0100 Subject: [PATCH 3/7] Add interface file Signed-off-by: Marek Kubica --- bin/main.ml | 4 ++-- lib/main.mlx | 7 ++++--- lib/metadata.ml | 4 ++++ lib/metadata.mli | 40 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 50 insertions(+), 5 deletions(-) create mode 100644 lib/metadata.mli diff --git a/bin/main.ml b/bin/main.ml index b73f15b..3ee4bd5 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -41,7 +41,7 @@ module Sync = struct Metadata.Bundle.create_daily ~commit ~tag Metadata.Target.defaults in let bundle_key = - match daily_bundle.tag with + match Metadata.Bundle.tag daily_bundle with | Some tag -> tag | None -> Metadata.Bundle.get_date_string_from daily_bundle in @@ -120,7 +120,7 @@ module Http = struct | None -> "" | Some bundle -> (* guaranteed to exist at this point *) - Option.get bundle.tag + bundle |> Metadata.Bundle.tag |> Option.get in let routes = let main_page = Web.generate_main_page ~title ~base_url ~latest_release bundles in diff --git a/lib/main.mlx b/lib/main.mlx index fab14ea..d806705 100644 --- a/lib/main.mlx +++ b/lib/main.mlx @@ -260,7 +260,8 @@ let manual_installation ~base_url ~builds () =

    (let bundle: Metadata.Bundle.t = builds |> List.hd in - bundle.targets + bundle + |> Metadata.Bundle.targets |> List.map (installation_target ~base_url ~bundle) |> JSX.list)
@@ -305,7 +306,7 @@ let release_information ~base_url ~bundle ~target () = "Archive" (JSX.string os) (JSX.string arch) - (String.sub bundle.commit 0 6 |> JSX.string) + (String.sub (Metadata.Bundle.commit bundle) 0 6 |> JSX.string)
@@ -331,7 +332,7 @@ let build_history ~base_url ~builds () = |> List.map (fun (bundle: Bundle.t) -> let date = Bundle.get_date_string_from ~prefix:"nightly-" bundle in let summary = Format.sprintf "dune %s" date in - let files = bundle.targets |> List.map (fun (target: Target.t) -> ()) in + let files = bundle |> Metadata.Bundle.targets |> List.map (fun (target: Target.t) -> ()) in (
diff --git a/lib/metadata.ml b/lib/metadata.ml index f1d3072..2612e03 100644 --- a/lib/metadata.ml +++ b/lib/metadata.ml @@ -73,6 +73,10 @@ module Bundle = struct { date; targets; commit; tag; has_certificate = true } ;; + let targets { targets; _ } = targets + let commit { commit; _ } = commit + let tag { tag; _ } = tag + let create_daily targets = let date = Unix.time () |> Ptime.of_float_s |> Option.get |> Ptime.to_date in create ~date targets diff --git a/lib/metadata.mli b/lib/metadata.mli new file mode 100644 index 0000000..c431f41 --- /dev/null +++ b/lib/metadata.mli @@ -0,0 +1,40 @@ +module Target : sig + type t + + val to_human_readable_string : t -> string + val to_description : t -> string + val to_triple : t -> string * string * string + val of_string : string -> t option + val defaults : t list +end + +module Bundle : sig + type t + + val targets : t -> Target.t list + val commit : t -> string + val tag : t -> string option + val to_download_file : Target.t -> string + val to_download_url : base_url:string -> target:Target.t -> t -> string + val to_certificate_url : base_url:string -> target:Target.t -> t -> string + val get_date_string_from : ?prefix:string -> t -> string + + (* creates a bundle with the current date *) + val create_daily : Target.t list -> commit:string -> tag:string option -> t + + (* returns [true] if the bundle matches the query *) + val matches_criteria : tag:string option -> target:Target.t -> t -> bool + + (* returns the bundle with the highest version number *) + val newest_tagged : t list -> t option +end + +(* [import_from_json filename] reads the file and parses it into a list of [Bundle.t] *) +val import_from_json : string -> Bundle.t list + +(* [export_to_json filename bundles] takes bundles and writes them to the specified + file name. *) +val export_to_json : string -> Bundle.t list -> unit + +(* Inserts a new bundle into the list unless there is already an equivalent one. *) +val insert_unique : Bundle.t -> Bundle.t list -> Bundle.t list From 9dc18ed613c16d0e9e5952dfbf3aa52d976fc02b Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 13:54:11 +0100 Subject: [PATCH 4/7] Add explicit route Signed-off-by: Marek Kubica --- bin/server.ml | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/bin/server.ml b/bin/server.ml index 0c46b1c..af9c213 100644 --- a/bin/server.ml +++ b/bin/server.ml @@ -47,12 +47,17 @@ let latest_route_from_targets ~base_url bundles request = let stable_release ~base_url bundles request = let module Target = Sandworm.Metadata.Target in - let release = - match Dream.param request "release" with - | "latest" -> Latest - | version -> Specific version - in let target = Dream.param request "target" in + let release = Specific (Dream.param request "release") in + match Target.of_string target with + | None -> Dream.respond ~status:`Not_Found "Invalid target" + | Some target -> matching_bundle bundles ~base_url ~target ~tag:(Some release) request +;; + +let latest_stable_release ~base_url bundles request = + let module Target = Sandworm.Metadata.Target in + let target = Dream.param request "target" in + let release = Latest in match Target.of_string target with | None -> Dream.respond ~status:`Not_Found "Invalid target" | Some target -> matching_bundle bundles ~base_url ~target ~tag:(Some release) request @@ -92,6 +97,7 @@ let serve ~dev ~base_url routes port bundles = ; Dream.get "/install" (fun request -> Dream.redirect request "/static/install") ; Dream.get "/static/**" @@ Dream.static "static" ; Dream.get "/latest/:target" (latest_route_from_targets ~base_url bundles) + ; Dream.get "/stable/latest/:target" (latest_stable_release ~base_url bundles) ; Dream.get "/stable/:release/:target" (stable_release ~base_url bundles) ]) ;; From e288e47094d24d18f25fe4b37508fc06d9eddf38 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 13:57:46 +0100 Subject: [PATCH 5/7] Deduplicate target check Signed-off-by: Marek Kubica --- bin/server.ml | 27 +++++++++++++-------------- 1 file changed, 13 insertions(+), 14 deletions(-) diff --git a/bin/server.ml b/bin/server.ml index af9c213..0b8f23f 100644 --- a/bin/server.ml +++ b/bin/server.ml @@ -37,30 +37,29 @@ let matching_bundle ~base_url bundles ~target ~tag request = Dream.redirect request (Bundle.to_download_url ~base_url ~target bundle) ;; -let latest_route_from_targets ~base_url bundles request = +let with_valid_target request f = let module Target = Sandworm.Metadata.Target in let target = Dream.param request "target" in match Target.of_string target with | None -> Dream.respond ~status:`Not_Found "Invalid target" - | Some target -> matching_bundle bundles ~base_url ~target ~tag:None request + | Some target -> f target +;; + +let latest_route_from_targets ~base_url bundles request = + with_valid_target request + @@ fun target -> matching_bundle bundles ~base_url ~target ~tag:None request ;; let stable_release ~base_url bundles request = - let module Target = Sandworm.Metadata.Target in - let target = Dream.param request "target" in - let release = Specific (Dream.param request "release") in - match Target.of_string target with - | None -> Dream.respond ~status:`Not_Found "Invalid target" - | Some target -> matching_bundle bundles ~base_url ~target ~tag:(Some release) request + let tag = Some (Specific (Dream.param request "release")) in + with_valid_target request + @@ fun target -> matching_bundle bundles ~base_url ~target ~tag request ;; let latest_stable_release ~base_url bundles request = - let module Target = Sandworm.Metadata.Target in - let target = Dream.param request "target" in - let release = Latest in - match Target.of_string target with - | None -> Dream.respond ~status:`Not_Found "Invalid target" - | Some target -> matching_bundle bundles ~base_url ~target ~tag:(Some release) request + let tag = Some Latest in + with_valid_target request + @@ fun target -> matching_bundle bundles ~base_url ~target ~tag request ;; let error_template _error _debug_info suggested_response = From ef05cba599158e1d2bb0f1757269d6267251f1d5 Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Wed, 11 Mar 2026 14:32:18 +0100 Subject: [PATCH 6/7] Document the endpoint Signed-off-by: Marek Kubica --- lib/main.mlx | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/main.mlx b/lib/main.mlx index d806705..ff99247 100644 --- a/lib/main.mlx +++ b/lib/main.mlx @@ -51,10 +51,16 @@ let getting_started ~install_url ~latest_release:version () =

- "Copy & Install (stable)" + "Copy & Install (current stable)"

+

+ + "Copy & Install (latest stable)" +

+ +

"Getting Started"

"You can create and run your first hello-world program using Dune like this"

From d0c1dbdbab97b564ed7dafc8710866bb9c1115ab Mon Sep 17 00:00:00 2001 From: Marek Kubica Date: Thu, 12 Mar 2026 11:10:31 +0100 Subject: [PATCH 7/7] Refactor `newest_tagged` Signed-off-by: Marek Kubica --- lib/metadata.ml | 73 +++++++++++++++++++++++++++++++++++++------------ 1 file changed, 55 insertions(+), 18 deletions(-) diff --git a/lib/metadata.ml b/lib/metadata.ml index 2612e03..c8087fe 100644 --- a/lib/metadata.ml +++ b/lib/metadata.ml @@ -94,26 +94,63 @@ module Bundle = struct | Some t -> List.mem target t.targets ;; + module Version = struct + module Compare = struct + module Syntax = struct + let ( let+ ) comparison_result continue = + match comparison_result with + | 0 -> continue () + | non_equal -> non_equal + ;; + end + end + + let parse tag = Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z) + + let compare (maj, min, patch) (maj', min', patch') = + let open Compare.Syntax in + let+ () = Int.compare maj maj' in + let+ () = Int.compare min min' in + Int.compare patch patch' + ;; + end + + module Option = struct + include Option + + module Syntax = struct + let ( let+ ) v f = map f v + let ( let* ) = bind + end + end + + let bundle_with_tag bundle = + let open Option.Syntax in + let* tag = bundle.tag in + let+ tag = Version.parse tag in + tag, bundle + ;; + + let max_bundle_by_version previous candidate = + match previous with + | None -> Some candidate + | Some previous -> + let previous_version, _ = previous in + let candidate_version, _ = candidate in + if Version.compare previous_version candidate_version < 0 + then Some candidate + else Some previous + ;; + let newest_tagged bundles = bundles - |> List.filter_map (fun bundle -> - match bundle.tag with - | None -> None - | Some tag -> - (match Scanf.sscanf_opt tag "%d.%d.%d" (fun x y z -> x, y, z) with - | None -> None - | Some tup -> Some (tup, bundle))) - |> List.sort (fun ((maj, min, patch), _) ((maj', min', patch'), _) -> - (* reverse sort, biggest first *) - match Int.compare maj' maj with - | 0 -> - (match Int.compare min' min with - | 0 -> Int.compare patch' patch - | otherwise -> otherwise) - | otherwise -> otherwise) - |> function - | [] -> None - | (_, bundle) :: _ -> Some bundle + |> List.fold_left + (fun acc bundle -> + match bundle_with_tag bundle with + | None -> acc + | Some bundle_with_tag -> max_bundle_by_version acc bundle_with_tag) + None + |> Option.map snd ;; let get_date_string_from ?prefix t =