From 07831d7de3e319e4e539d5216b2ac840ce9db14e Mon Sep 17 00:00:00 2001 From: Hannes Mehnert Date: Mon, 2 Sep 2024 16:14:26 +0200 Subject: [PATCH] remove usage of cstruct, require mirage-crypto 1.0.0 --- auth/builder_web_auth.ml | 12 ++++----- auth/dune | 2 +- bin/builder_db_app.ml | 51 ++++++++++++++++++------------------ bin/migrations/m20210706.ml | 10 +++---- bin/migrations/m20210707c.ml | 7 ++--- bin/migrations/m20210712c.ml | 8 +++--- builder-web.opam | 13 +++++---- db/builder_db.ml | 24 ++++++++--------- db/builder_db.mli | 23 ++++++++-------- db/representation.ml | 25 +++++++----------- lib/builder_web.ml | 30 +++++++++------------ lib/dune | 4 +-- lib/model.ml | 13 ++++----- lib/model.mli | 2 +- lib/views.ml | 4 +-- test/dune | 2 +- test/router.ml | 7 +++-- test/test_builder_db.ml | 14 +++++----- 18 files changed, 120 insertions(+), 131 deletions(-) diff --git a/auth/builder_web_auth.ml b/auth/builder_web_auth.ml index e05e0ca..8689d00 100644 --- a/auth/builder_web_auth.ml +++ b/auth/builder_web_auth.ml @@ -12,9 +12,9 @@ let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () = { scrypt_n; scrypt_r; scrypt_p } type pbkdf2_sha256 = - [ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ] + [ `Pbkdf2_sha256 of string * string * pbkdf2_sha256_params ] -type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ] +type scrypt = [ `Scrypt of string * string * scrypt_params ] type password_hash = [ pbkdf2_sha256 | scrypt ] @@ -25,10 +25,10 @@ type 'a user_info = { } let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password = - Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password:(Cstruct.of_string password) + Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password let scrypt ~params:{ scrypt_n = n; scrypt_r = r; scrypt_p = p } ~salt ~password = - Scrypt_kdf.scrypt_kdf ~n ~r ~p ~dk_len:32l ~salt ~password:(Cstruct.of_string password) + Scrypt.scrypt ~n ~r ~p ~dk_len:32l ~salt ~password let hash ?(scrypt_params=scrypt_params ()) ~username ~password ~restricted () = @@ -43,10 +43,10 @@ let hash ?(scrypt_params=scrypt_params ()) let verify_password password user_info = match user_info.password_hash with | `Pbkdf2_sha256 (password_hash, salt, params) -> - Cstruct.equal + String.equal (pbkdf2_sha256 ~params ~salt ~password) password_hash | `Scrypt (password_hash, salt, params) -> - Cstruct.equal + String.equal (scrypt ~params ~salt ~password) password_hash diff --git a/auth/dune b/auth/dune index 5ebfb7d..97debb3 100644 --- a/auth/dune +++ b/auth/dune @@ -1,3 +1,3 @@ (library (name builder_web_auth) - (libraries pbkdf scrypt-kdf mirage-crypto-rng)) + (libraries kdf.pbkdf kdf.scrypt mirage-crypto-rng)) diff --git a/bin/builder_db_app.ml b/bin/builder_db_app.ml index ac52622..0ade5e4 100644 --- a/bin/builder_db_app.ml +++ b/bin/builder_db_app.ml @@ -17,7 +17,7 @@ let defer_foreign_keys = "PRAGMA defer_foreign_keys = ON" let build_artifacts_to_orphan = - Builder_db.Rep.id `build ->* Builder_db.Rep.cstruct @@ + Builder_db.Rep.id `build ->* Caqti_type.octets @@ {| SELECT a.sha256 FROM build_artifact a WHERE a.build = ? AND (SELECT COUNT(*) FROM build_artifact a2 @@ -45,7 +45,7 @@ let migrate () dbpath = let artifacts_dir datadir = Fpath.(datadir / "_artifacts") let artifact_path sha256 = - let (`Hex sha256) = Hex.of_cstruct sha256 in + let sha256 = Ohex.encode sha256 in (* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *) (* NOTE: We add the prefix to reduce the number of files in a directory - a workaround for inferior filesystems. We can easily revert this by changing @@ -108,7 +108,7 @@ let user_disable () dbpath username = match user with | None -> Error (`Msg "user not found") | Some (_, user_info) -> - let password_hash = `Scrypt (Cstruct.empty, Cstruct.empty, Builder_web_auth.scrypt_params ()) in + let password_hash = `Scrypt ("", "", Builder_web_auth.scrypt_params ()) in let user_info = { user_info with password_hash ; restricted = true } in Db.exec Builder_db.User.update_user user_info in @@ -296,12 +296,12 @@ let vacuum () datadir platform_opt jobnames predicate = or_die 1 r let input_ids = - Caqti_type.unit ->* Builder_db.Rep.cstruct @@ + Caqti_type.unit ->* Caqti_type.octets @@ "SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL" let main_artifact_hash = - Builder_db.Rep.cstruct ->* - Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@ + Caqti_type.octets ->* + Caqti_type.t3 Caqti_type.octets Builder_db.Rep.uuid Caqti_type.string @@ {| SELECT a.sha256, b.uuid, j.name FROM build_artifact a, build b, job j WHERE b.input_id = ? AND a.id = b.main_binary AND b.job = j.id @@ -319,12 +319,12 @@ let verify_input_id () dbpath = match hashes with | (h, uuid, jobname) :: tl -> List.iter (fun (h', uuid', _) -> - if Cstruct.equal h h' then + if String.equal h h' then () else Logs.warn (fun m -> m "job %s input id %a with two different hashes (%a, %a), build %a and %a" - jobname Cstruct.hexdump_pp input_id - Cstruct.hexdump_pp h Cstruct.hexdump_pp h' + jobname Ohex.pp input_id + Ohex.pp h Ohex.pp h' Uuidm.pp uuid Uuidm.pp uuid')) tl | [] -> ()) @@ -336,10 +336,9 @@ let num_build_artifacts = Caqti_type.unit ->! Caqti_type.int @@ "SELECT count(*) FROM build_artifact" -let build_artifacts : (unit, string * Uuidm.t * Fpath.t * Cstruct.t * int64, [ `One | `Zero | `Many ]) Caqti_request.t = +let build_artifacts : (unit, string * Uuidm.t * Fpath.t * string * int64, [ `One | `Zero | `Many ]) Caqti_request.t = Caqti_type.unit ->* - Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath - Builder_db.Rep.cstruct int64) + Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath octets int64) @@ {| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size FROM build_artifact a, build b, job @@ -397,12 +396,12 @@ let verify_data_dir () datadir = files_tracked := FpathSet.add (artifact_path sha256) !files_tracked; let s = Int64.of_int (String.length data) in if s <> size then Logs.err (fun m -> m "File %a has different size (in DB %Lu on disk %Lu)" Fpath.pp abs_path size s); - let sha256' = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in - if not (Cstruct.equal sha256 sha256') then + let sha256' = Digestif.SHA256.(to_raw_string (digest_string data)) in + if not (String.equal sha256 sha256') then Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)" Fpath.pp abs_path - Hex.pp (Hex.of_cstruct sha256) - Hex.pp (Hex.of_cstruct sha256'))) ; + Ohex.pp sha256 + Ohex.pp sha256')) ; Ok () else Ok () @@ -545,8 +544,8 @@ module Verify_cache_dir = struct type t = { uuid : Uuidm.t; job_name : string; - hash_opam_switch : Cstruct.t option; - hash_debug_bin : Cstruct.t option; + hash_opam_switch : string option; + hash_debug_bin : string option; } let repr = @@ -560,8 +559,8 @@ module Verify_cache_dir = struct t4 Builder_db.Rep.uuid string - (option Builder_db.Rep.cstruct) - (option Builder_db.Rep.cstruct)) + (option octets) + (option octets)) end @@ -587,7 +586,7 @@ module Verify_cache_dir = struct let* latest_version = Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ in - let `Hex viz_input_hash = Hex.of_cstruct hash in + let viz_input_hash = Ohex.encode hash in let* viz_path = Viz_aux.choose_versioned_viz_path ~cachedir @@ -667,7 +666,7 @@ module Verify_cache_dir = struct match extract_hash ~viz_typ build with | None -> () | Some input_hash -> - let `Hex input_hash = Hex.of_cstruct input_hash in + let input_hash = Ohex.encode input_hash in let viz_path = Viz_aux.viz_path ~cachedir ~viz_typ @@ -741,8 +740,8 @@ end module Asn = struct let decode_strict codec cs = match Asn.decode codec cs with - | Ok (a, cs) -> - if Cstruct.length cs = 0 + | Ok (a, rest) -> + if String.length rest = 0 then Ok a else Error "trailing bytes" | Error (`Parse msg) -> Error ("parse error: " ^ msg) @@ -808,8 +807,8 @@ let extract_full () datadir dest uuid = artifacts in let exec = (job, uuid, out, start, finish, result, data) in - let cs = Builder.Asn.exec_to_cs exec in - Bos.OS.File.write (Fpath.v dest) (Cstruct.to_string cs) + let data = Builder.Asn.exec_to_str exec in + Bos.OS.File.write (Fpath.v dest) data in or_die 1 r diff --git a/bin/migrations/m20210706.ml b/bin/migrations/m20210706.ml index a0d07b9..5f727e7 100644 --- a/bin/migrations/m20210706.ml +++ b/bin/migrations/m20210706.ml @@ -57,9 +57,9 @@ let builds = Caqti_type.unit ->* Caqti_type.t4 Builder_db.Rep.untyped_id - Builder_db.Rep.cstruct - Builder_db.Rep.cstruct - Builder_db.Rep.cstruct @@ + Caqti_type.octets + Caqti_type.octets + Caqti_type.octets @@ {| SELECT b.id, opam.sha256, env.sha256, system.sha256 FROM build b, build_artifact opam, build_artifact env, build_artifact system WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment' @@ -68,7 +68,7 @@ let builds = |} let set_input_id = - Caqti_type.t2 Builder_db.Rep.untyped_id Builder_db.Rep.cstruct ->. Caqti_type.unit @@ + Caqti_type.t2 Builder_db.Rep.untyped_id Caqti_type.octets ->. Caqti_type.unit @@ "UPDATE build SET input_id = $2 WHERE id = $1" let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = @@ -76,7 +76,7 @@ let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = Db.exec add_input_id_to_build () >>= fun () -> Db.collect_list builds () >>= fun builds -> Grej.list_iter_result (fun (id, opam_sha, env_sha, pkg_sha) -> - let input_id = Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [ opam_sha ; env_sha ; pkg_sha ]) in + let input_id = Digestif.SHA256.(to_raw_string (digestv_string [ opam_sha ; env_sha ; pkg_sha ])) in Db.exec set_input_id (id, input_id)) builds >>= fun () -> Db.exec (Grej.set_version new_version) () diff --git a/bin/migrations/m20210707c.ml b/bin/migrations/m20210707c.ml index 99bb10b..b0783aa 100644 --- a/bin/migrations/m20210707c.ml +++ b/bin/migrations/m20210707c.ml @@ -16,8 +16,8 @@ let update_paths : ([`build_artifact] Builder_db.Rep.id * Fpath.t * Fpath.t, uni Caqti_type.unit @@ "UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1" -let add_artifact : ((Fpath.t * Fpath.t * Cstruct.t) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t = - Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Builder_db.Rep.cstruct) +let add_artifact : ((Fpath.t * Fpath.t * string) * (int64 * [`build] Builder_db.Rep.id), unit, [ `Zero]) Caqti_request.t = + Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Caqti_type.octets) (t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->. Caqti_type.unit @@ "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)" @@ -48,7 +48,8 @@ let fixup datadir (module Db : Caqti_blocking.CONNECTION) = in assert (r = 0); Bos.OS.File.read (Fpath.append datadir artifact_lpath) >>= fun data -> - let size = Int64.of_int (String.length data) and sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in + let size = Int64.of_int (String.length data) + and sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in Db.exec update_paths (artifact_id, new_artifact_lpath, path artifact_fpath) >>= fun () -> Db.exec add_artifact ((artifact_fpath, artifact_lpath, sha256), (size, build_id)) >>= fun () -> Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id -> diff --git a/bin/migrations/m20210712c.ml b/bin/migrations/m20210712c.ml index c1fc6fd..b2d950f 100644 --- a/bin/migrations/m20210712c.ml +++ b/bin/migrations/m20210712c.ml @@ -8,8 +8,8 @@ open Grej.Infix module Asn = struct let decode_strict codec cs = match Asn.decode codec cs with - | Ok (a, cs) -> - if Cstruct.length cs = 0 + | Ok (a, rest) -> + if String.length rest = 0 then Ok a else Error "trailing bytes" | Error (`Parse msg) -> Error ("parse error: " ^ msg) @@ -96,7 +96,7 @@ let copy_from_new_build = let old_build_console_script = Caqti_type.unit ->* Caqti_type.(t4 (Builder_db.Rep.id (`build : [ `build ])) - (t2 string Builder_db.Rep.uuid) Builder_db.Rep.cstruct string) @@ + (t2 string Builder_db.Rep.uuid) octets string) @@ "SELECT b.id, job.name, b.uuid, b.console, b.script FROM build b, job WHERE b.job = job.id" let update_new_build_console_script = @@ -112,7 +112,7 @@ let new_build_console_script = "SELECT id, console, script FROM build" let update_old_build_console_script = - Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) Builder_db.Rep.cstruct string) ->. + Caqti_type.(t3 (Builder_db.Rep.id (`build : [ `build ])) octets string) ->. Caqti_type.unit @@ "UPDATE new_build SET console = $2, script = $3 WHERE id = $1" diff --git a/builder-web.opam b/builder-web.opam index e457876..52ac41b 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -18,17 +18,15 @@ depends: [ "ocaml" {>= "4.13.0"} "dune" {>= "2.7.0"} "builder" {>= "0.2.0"} - "dream" {>= "1.0.0~alpha4"} - "cstruct" {>= "6.0.0"} + "dream" {>= "1.0.0~alpha7"} "bos" - "hex" + "ohex" {>= "0.2.0"} "lwt" {>= "5.7.0"} "caqti" {>= "2.1.1"} "caqti-lwt" "caqti-driver-sqlite3" - "pbkdf" "mirage-crypto-rng" {>= "0.11.0"} - "scrypt-kdf" + "kdf" "opam-core" "opam-format" {>= "2.1.0"} "metrics" {>= "0.3.0"} @@ -39,8 +37,8 @@ depends: [ "tyxml" {>= "4.3.0"} "ptime" "duration" - "mirage-crypto" - "asn1-combinators" + "mirage-crypto" {>= "1.0.0"} + "asn1-combinators" {>= "0.3.0"} "logs" "cmdliner" {>= "1.1.0"} "uri" @@ -51,6 +49,7 @@ depends: [ "owee" "solo5-elftool" {>= "0.3.0"} "decompress" {>= "1.5.0"} + "digestif" {>= "1.2.0"} "alcotest" {>= "1.2.0" & with-test} "ppx_deriving" {with-test} "ppx_deriving_yojson" {with-test} diff --git a/db/builder_db.ml b/db/builder_db.ml index 4e10acf..1a0cd7e 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -12,7 +12,7 @@ type 'a id = 'a Rep.id type file = Rep.file = { filepath : Fpath.t; - sha256 : Cstruct.t; + sha256 : string; size : int; } @@ -172,7 +172,7 @@ module Build_artifact = struct "SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?" let exists = - cstruct ->! Caqti_type.bool @@ + Caqti_type.octets ->! Caqti_type.bool @@ "SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)" let add = @@ -199,7 +199,7 @@ module Build = struct script : Fpath.t; platform : string; main_binary : [`build_artifact] id option; - input_id : Cstruct.t option; + input_id : string option; user_id : [`user] id; job_id : [`job] id; } @@ -224,7 +224,7 @@ module Build = struct Fpath.pp t.script t.platform Fmt.(Dump.option int64) t.main_binary - Fmt.(Dump.option (using Cstruct.to_string string)) t.input_id + Fmt.(Dump.option string) t.input_id t.user_id t.job_id @@ -240,7 +240,7 @@ module Build = struct fpath string (option (Rep.id `build_artifact)) - (option Rep.cstruct) + (option octets) (id `user) (id `job)) in @@ -314,7 +314,7 @@ module Build = struct |} let get_all_artifact_sha = - Caqti_type.(t2 (id `job) (option string)) ->* Rep.cstruct @@ + Caqti_type.(t2 (id `job) (option string)) ->* Caqti_type.octets @@ {| SELECT DISTINCT a.sha256 FROM build_artifact a, build b WHERE b.job = $1 AND b.main_binary = a.id @@ -446,7 +446,7 @@ module Build = struct |} let get_same_input_different_output_hashes = - id `build ->* Rep.cstruct @@ + id `build ->* Caqti_type.octets @@ {| SELECT DISTINCT a.sha256 FROM build b0, build_artifact a0, build b, build_artifact a WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 <> a.sha256 @@ -455,7 +455,7 @@ module Build = struct |} let get_different_input_same_output_input_ids = - id `build ->* Rep.cstruct @@ + id `build ->* Caqti_type.octets @@ {| SELECT DISTINCT b.input_id FROM build b0, build_artifact a0, build b, build_artifact a WHERE b0.id = ? AND a0.id = b0.main_binary AND a0.sha256 = a.sha256 @@ -463,7 +463,7 @@ module Build = struct |} let get_one_by_input_id = - Rep.cstruct ->! t @@ + Caqti_type.octets ->! t @@ {| SELECT uuid, start_d, start_ps, finish_d, finish_ps, result_code, result_msg, console, script, platform, main_binary, input_id, user, job @@ -487,7 +487,7 @@ module Build = struct |} let get_by_hash = - Rep.cstruct ->! t @@ + Caqti_type.octets ->! t @@ {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_code, b.result_msg, b.console, b.script, @@ -500,7 +500,7 @@ module Build = struct |} let get_with_main_binary_by_hash = - Rep.cstruct ->! Caqti_type.t2 t file_opt @@ + Caqti_type.octets ->! Caqti_type.t2 t file_opt @@ {| SELECT b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_code, b.result_msg, b.console, b.script, b.platform, b.main_binary, b.input_id, b.user, b.job, @@ -513,7 +513,7 @@ module Build = struct |} let get_with_jobname_by_hash = - Rep.cstruct ->? Caqti_type.t2 Caqti_type.string t @@ + Caqti_type.octets ->? Caqti_type.t2 Caqti_type.string t @@ {| SELECT job.name, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.result_code, b.result_msg, diff --git a/db/builder_db.mli b/db/builder_db.mli index 7264456..05b69d7 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -3,7 +3,7 @@ module Rep : sig type 'a id type file = { filepath : Fpath.t; - sha256 : Cstruct.t; + sha256 : string; size : int; } @@ -13,7 +13,6 @@ module Rep : sig val uuid : Uuidm.t Caqti_type.t val ptime : Ptime.t Caqti_type.t val fpath : Fpath.t Caqti_type.t - val cstruct : Cstruct.t Caqti_type.t val file : file Caqti_type.t val execution_result : Builder.execution_result Caqti_type.t val console : (int * string) list Caqti_type.t @@ -22,7 +21,7 @@ type 'a id = 'a Rep.id type file = Rep.file = { filepath : Fpath.t; - sha256 : Cstruct.t; + sha256 : string; size : int; } @@ -85,7 +84,7 @@ module Build_artifact : sig Caqti_request.t val get_all_by_build : ([`build] id, [`build_artifact] id * file, [ `Many | `One | `Zero ]) Caqti_request.t - val exists : (Cstruct.t, bool, [ `One ]) Caqti_request.t + val exists : (string, bool, [ `One ]) Caqti_request.t val add : (file * [`build] id, unit, [ `Zero ]) Caqti_request.t val remove_by_build : @@ -105,7 +104,7 @@ sig script : Fpath.t; platform : string; main_binary : [`build_artifact] id option; - input_id : Cstruct.t option; + input_id : string option; user_id : [`user] id; job_id : [`job] id; } @@ -120,7 +119,7 @@ sig val get_all_failed : (int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t val get_all_artifact_sha : - ([`job] id * string option, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t + ([`job] id * string option, string, [ `Many | `One | `Zero ]) Caqti_request.t val get_latest_successful_with_binary : ([`job] id * string, [`build] id * t * file, [ `One | `Zero ]) Caqti_request.t @@ -144,20 +143,20 @@ sig val get_same_input_same_output_builds : ([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t val get_same_input_different_output_hashes : - ([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t + ([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t val get_different_input_same_output_input_ids : - ([`build] id, Cstruct.t, [ `Many | `One | `Zero ]) Caqti_request.t + ([`build] id, string, [ `Many | `One | `Zero ]) Caqti_request.t val get_one_by_input_id : - (Cstruct.t, t, [ `One ]) Caqti_request.t + (string, t, [ `One ]) Caqti_request.t val get_platforms_for_job : ([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t val add : (t, unit, [ `Zero ]) Caqti_request.t val get_by_hash : - (Cstruct.t, t, [ `One]) Caqti_request.t + (string, t, [ `One]) Caqti_request.t val get_with_main_binary_by_hash : - (Cstruct.t, t * file option, [ `One]) Caqti_request.t + (string, t * file option, [ `One]) Caqti_request.t val get_with_jobname_by_hash : - (Cstruct.t, string * t, [ `One | `Zero]) Caqti_request.t + (string, string * t, [ `One | `Zero]) Caqti_request.t val set_main_binary : ([`build] id * [`build_artifact] id, unit, [ `Zero ]) Caqti_request.t val remove : ([`build] id, unit, [ `Zero]) Caqti_request.t end diff --git a/db/representation.ml b/db/representation.ml index c162fe6..7c1b18f 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -1,8 +1,8 @@ module Asn = struct let decode_strict codec cs = match Asn.decode codec cs with - | Ok (a, cs) -> - if Cstruct.length cs = 0 + | Ok (a, rest) -> + if String.length rest = 0 then Ok a else Error "trailing bytes" | Error (`Parse msg) -> Error ("parse error: " ^ msg) @@ -17,7 +17,7 @@ module Asn = struct (required ~label:"delta" int) (required ~label:"data" utf8_string))) - let console_of_cs, console_to_cs = projections_of console + let console_of_str, console_to_str = projections_of console end type untyped_id = int64 @@ -30,7 +30,7 @@ let id_to_int64 (id : 'a id) : int64 = id type file = { filepath : Fpath.t; - sha256 : Cstruct.t; + sha256 : string; size : int; } @@ -56,20 +56,15 @@ let fpath = |> Result.map_error (fun (`Msg s) -> s) in Caqti_type.custom ~encode ~decode Caqti_type.string -let cstruct = - let encode t = Ok (Cstruct.to_string t) in - let decode s = Ok (Cstruct.of_string s) in - Caqti_type.custom ~encode ~decode Caqti_type.octets - let file = let encode { filepath; sha256; size } = Ok (filepath, sha256, size) in let decode (filepath, sha256, size) = Ok { filepath; sha256; size } in - Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath cstruct int) + Caqti_type.custom ~encode ~decode Caqti_type.(t3 fpath octets int) let file_opt = - let rep = Caqti_type.(t3 (option fpath) (option cstruct) (option int)) in + let rep = Caqti_type.(t3 (option fpath) (option octets) (option int)) in let encode = function | Some { filepath; sha256; size } -> Ok (Some filepath, Some sha256, Some size) @@ -112,12 +107,12 @@ let execution_result = Caqti_type.custom ~encode ~decode rep let console = - let encode console = Ok (Asn.console_to_cs console) in - let decode data = Asn.console_of_cs data in - Caqti_type.custom ~encode ~decode cstruct + let encode console = Ok (Asn.console_to_str console) in + let decode data = Asn.console_of_str data in + Caqti_type.(custom ~encode ~decode octets) let user_info = - let rep = Caqti_type.(t7 string cstruct cstruct int int int bool) in + let rep = Caqti_type.(t7 string octets octets int int int bool) in let encode { Builder_web_auth.username; password_hash = `Scrypt (password_hash, password_salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 588b03a..af6c328 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -134,14 +134,14 @@ module Viz_aux = struct viz_dir ~cachedir ~viz_typ ~version / input_hash + "html" ) - + let choose_versioned_viz_path ~cachedir ~viz_typ ~viz_input_hash ~current_version = let ( >>= ) = Result.bind in - let rec aux current_version = + let rec aux current_version = let path = viz_path ~cachedir ~viz_typ @@ -153,7 +153,7 @@ module Viz_aux = struct Error (`Msg (Fmt.str "viz '%s': There exist no version of the requested \ visualization" (viz_type_to_string viz_typ))) - else + else aux @@ pred current_version ) in @@ -162,7 +162,7 @@ module Viz_aux = struct let get_viz_version_from_dirs ~cachedir ~viz_typ = let ( >>= ) = Result.bind in Bos.OS.Dir.contents cachedir >>= fun versioned_dirs -> - let max_cached_version = + let max_cached_version = let viz_typ_str = viz_type_to_string viz_typ ^ "_" in versioned_dirs |> List.filter_map (fun versioned_dir -> @@ -171,7 +171,7 @@ module Viz_aux = struct Logs.warn (fun m -> m "%s" err); None | Ok false -> None - | Ok true -> + | Ok true -> let dir_str = Fpath.filename versioned_dir in if not (String.starts_with ~prefix:viz_typ_str dir_str) then None @@ -199,10 +199,6 @@ module Viz_aux = struct let hash_viz_input ~uuid typ db = let open Builder_db in - let hex cstruct = - let `Hex hex_str = Hex.of_cstruct cstruct in - hex_str - in main_binary_of_uuid uuid db >>= fun main_binary -> Model.build uuid db |> if_error "Error getting build" >>= fun (build_id, _build) -> @@ -210,7 +206,7 @@ module Viz_aux = struct |> if_error "Error getting build artifacts" >>= fun artifacts -> match typ with | `Treemap -> - let debug_binary = + let debug_binary = let bin = Fpath.base main_binary.filepath in List.find_opt (fun p -> Fpath.(equal (bin + "debug") (base p.filepath))) @@ -220,10 +216,10 @@ module Viz_aux = struct Model.not_found debug_binary |> not_found_error >>= fun debug_binary -> debug_binary.sha256 - |> hex + |> Ohex.encode |> Lwt_result.return - end - | `Dependencies -> + end + | `Dependencies -> let opam_switch = List.find_opt (fun p -> Fpath.(equal (v "opam-switch") (base p.filepath))) @@ -232,7 +228,7 @@ module Viz_aux = struct Model.not_found opam_switch |> not_found_error >>= fun opam_switch -> opam_switch.sha256 - |> hex + |> Ohex.encode |> Lwt_result.return let try_load_cached_visualization ~cachedir ~uuid viz_typ db = @@ -428,7 +424,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = |> if_error ~status:`Not_Found "File not found" >>= fun filepath -> Dream.sql req (Model.build_artifact build filepath) |> if_error "Error getting build artifact" >>= fun file -> - let etag = Base64.encode_string (Cstruct.to_string file.Builder_db.sha256) in + let etag = Base64.encode_string file.Builder_db.sha256 in match if_none_match with | Some etag' when etag = etag' -> Dream.empty `Not_Modified |> Lwt_result.ok @@ -498,7 +494,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = let upload req = let* body = Dream.body req in - Builder.Asn.exec_of_cs (Cstruct.of_string body) |> Lwt.return + Builder.Asn.exec_of_str body |> Lwt.return |> if_error ~status:`Bad_Request "Bad request" ~log:(fun e -> Log.warn (fun m -> m "Received bad builder ASN.1"); @@ -530,7 +526,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs = Dream.query req "sha256" |> Option.to_result ~none:(`Msg "Missing sha256 query parameter") |> Lwt.return |> if_error ~status:`Bad_Request "Bad request" >>= fun hash_hex -> - begin try Hex.to_cstruct (`Hex hash_hex) |> Lwt_result.return + begin try Ohex.decode hash_hex |> Lwt_result.return with Invalid_argument e -> Lwt_result.fail (`Msg ("Bad hex: " ^ e)) end |> if_error ~status:`Bad_Request "Bad request" >>= fun hash -> diff --git a/lib/dune b/lib/dune index 339158a..9418899 100644 --- a/lib/dune +++ b/lib/dune @@ -1,5 +1,5 @@ (library (name builder_web) - (libraries builder builder_db dream tyxml bos duration hex caqti-lwt + (libraries builder builder_db dream tyxml bos duration ohex caqti-lwt opamdiff ptime.clock.os cmarkit tar tar.gz tar-unix owee solo5-elftool decompress.de - decompress.gz uri)) + decompress.gz uri digestif)) diff --git a/lib/model.ml b/lib/model.ml index 1be5bfa..7cd7d9f 100644 --- a/lib/model.ml +++ b/lib/model.ml @@ -20,7 +20,7 @@ let not_found = function let staging datadir = Fpath.(datadir / "_staging") let artifact_path artifact = - let (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in + let sha256 = Ohex.encode artifact.Builder_db.sha256 in (* NOTE: [sha256] is 64 characters when it's a hex sha256 checksum *) (* NOTE: We add the prefix to reduce the number of files in a directory - a workaround for inferior filesystems. We can easily revert this by changing @@ -221,7 +221,7 @@ let save_artifacts staging artifacts = List.fold_left (fun r (file, data) -> r >>= fun () -> - let (`Hex sha256) = Hex.of_cstruct file.Builder_db.sha256 in + let sha256 = Ohex.encode file.Builder_db.sha256 in let destpath = Fpath.(staging / sha256) in save destpath data) (Lwt_result.return ()) @@ -232,7 +232,7 @@ let commit_files datadir staging_dir job_name uuid artifacts = List.fold_left (fun r artifact -> r >>= fun () -> - let (`Hex sha256) = Hex.of_cstruct artifact.Builder_db.sha256 in + let sha256 = Ohex.encode artifact.Builder_db.sha256 in let src = Fpath.(staging_dir / sha256) in let dest = Fpath.(datadir // artifact_path artifact) in Lwt.return (Bos.OS.Dir.create (Fpath.parent dest)) >>= fun _created -> @@ -306,7 +306,8 @@ let compute_input_id artifacts = get_hash (Fpath.v "build-environment"), get_hash (Fpath.v "system-packages") with - | Some a, Some b, Some c -> Some (Mirage_crypto.Hash.SHA256.digest (Cstruct.concat [a;b;c])) + | Some a, Some b, Some c -> + Some Digestif.SHA256.(to_raw_string (digestv_string [a;b;c])) | _ -> None let save_console_and_script staging_dir job_name uuid console script = @@ -377,7 +378,7 @@ let add_build if not_interesting filepath then Lwt_result.return acc else - let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) + let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) and size = String.length data in Lwt_result.ok (Lwt.pause ()) >|= fun () -> ({ filepath; sha256; size }, data) :: acc) @@ -483,7 +484,7 @@ let add_build and uuid = Uuidm.to_string uuid and job = job.name and platform = job.platform - and `Hex sha256 = Hex.of_cstruct main_binary.sha256 + and sha256 = Ohex.encode main_binary.sha256 in let fp_str p = Fpath.(to_string (datadir // p)) in let args = diff --git a/lib/model.mli b/lib/model.mli index c062f92..b59e19c 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -33,7 +33,7 @@ val build : Uuidm.t -> Caqti_lwt.connection -> val build_with_main_binary : [`job] Builder_db.id -> string -> Caqti_lwt.connection -> ((Builder_db.Build.t * Builder_db.file) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t -val build_hash : Cstruct.t -> Caqti_lwt.connection -> +val build_hash : string -> Caqti_lwt.connection -> ((string * Builder_db.Build.t) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t val build_exists : Uuidm.t -> Caqti_lwt.connection -> diff --git a/lib/views.ml b/lib/views.ml index 8a597f8..630c8a3 100644 --- a/lib/views.ml +++ b/lib/views.ml @@ -202,7 +202,7 @@ let artifact else txtf "%a" Fpath.pp filepath ]; H.txt " "; - H.code [txtf "SHA256:%a" Hex.pp (Hex.of_cstruct sha256)]; + H.code [txtf "SHA256:%a" Ohex.pp sha256]; txtf " (%a)" Fmt.byte_size size; ] @@ -491,7 +491,7 @@ module Job_build = struct pp_devices block_devices pp_devices net_devices] in let aux (file:Builder_db.file) = - let (`Hex sha256_hex) = Hex.of_cstruct file.sha256 in + let sha256_hex = Ohex.encode file.sha256 in [ H.dt [ H.a ~a:H.[a_href @@ Link.Job_build_artifact.make diff --git a/test/dune b/test/dune index 9bc8ae4..af894d9 100644 --- a/test/dune +++ b/test/dune @@ -1,7 +1,7 @@ (test (name test_builder_db) (modules test_builder_db) - (libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix)) + (libraries ptime.clock.os builder_db caqti.blocking alcotest mirage-crypto-rng.unix ohex)) (test (name markdown_to_html) diff --git a/test/router.ml b/test/router.ml index 1cafd5a..65ba2d7 100644 --- a/test/router.ml +++ b/test/router.ml @@ -165,10 +165,9 @@ let () = .. to find them I follewed the trails of 'Albatross_cli.http_host' *) begin - let `Hex sha_str = - Cstruct.of_string "foo" - |> Mirage_crypto.Hash.SHA256.digest - |> Hex.of_cstruct + let sha_str = + Digestif.SHA256.(to_raw_string (digest_string "foo")) + |> Ohex.encode in Fmt.str "/hash?sha256=%s" sha_str end; diff --git a/test/test_builder_db.ml b/test/test_builder_db.ml index a0de17f..5ef158d 100644 --- a/test/test_builder_db.ml +++ b/test/test_builder_db.ml @@ -25,8 +25,8 @@ module Testable = struct x.restricted = y.restricted && match x.password_hash, y.password_hash with | `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') -> - Cstruct.equal hash hash' && - Cstruct.equal salt salt' && + String.equal hash hash' && + String.equal salt salt' && params = params' in let pp ppf { Builder_web_auth.username; password_hash; restricted } = @@ -34,7 +34,7 @@ module Testable = struct | `Scrypt (hash, salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p }) -> Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username scrypt_n scrypt_r scrypt_p restricted - Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt + Ohex.pp hash Ohex.pp salt in Alcotest.testable pp @@ -43,7 +43,7 @@ module Testable = struct let file = let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) = Fpath.equal x.filepath y.filepath && - Cstruct.equal x.sha256 y.sha256 && + String.equal x.sha256 y.sha256 && x.size = y.size in let pp ppf { Builder_db.Rep.filepath; sha256; size } = @@ -51,7 +51,7 @@ module Testable = struct sha256 = %a;@;<1 0>\ size = %d;@;<1 0>\ @]@,}" - Fpath.pp filepath Cstruct.hexdump_pp sha256 size + Fpath.pp filepath Ohex.pp sha256 size in Alcotest.testable pp equal @@ -131,12 +131,12 @@ let result = Builder.Exited 0 let main_binary = let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in let data = "#!/bin/sh\necho Hello, World\n" in - let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in + let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in let size = String.length data in { Builder_db.Rep.filepath; sha256; size } let main_binary2 = let data = "#!/bin/sh\necho Hello, World 2\n" in - let sha256 = Mirage_crypto.Hash.SHA256.digest (Cstruct.of_string data) in + let sha256 = Digestif.SHA256.(to_raw_string (digest_string data)) in let size = String.length data in { main_binary with sha256 ; size } let platform = "exotic-os"