robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

remove usage of cstruct, require mirage-crypto 1.0.0 #1

Merged
reynir merged 5 commits from no-cstruct into main 2024-09-05 15:12:38 +00:00
Conversation 3 Commits 5 Files changed 20 +123 -136
20 changed files with 123 additions and 136 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
auth/builder_web_auth.ml
View file

@ -12,9 +12,9 @@ let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () =
{ scrypt_n; scrypt_r; scrypt_p } { scrypt_n; scrypt_r; scrypt_p }
type pbkdf2_sha256 = 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 ] type password_hash = [ pbkdf2_sha256 | scrypt ]
@ -25,10 +25,10 @@ type 'a user_info = {
} }
let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password = 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 = 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 ()) let hash ?(scrypt_params=scrypt_params ())
~username ~password ~restricted () = ~username ~password ~restricted () =
@ -43,10 +43,10 @@ let hash ?(scrypt_params=scrypt_params ())
let verify_password password user_info = let verify_password password user_info =
match user_info.password_hash with match user_info.password_hash with
| `Pbkdf2_sha256 (password_hash, salt, params) -> | `Pbkdf2_sha256 (password_hash, salt, params) ->
Cstruct.equal String.equal
reynir commented 2024-09-04 06:09:43 +00:00
Review
Copy link

Here we should probably have used Eqaf in the first place. But let's save that for another PR.

Here we should probably have used Eqaf in the first place. But let's save that for another PR.
👍 1
(pbkdf2_sha256 ~params ~salt ~password) (pbkdf2_sha256 ~params ~salt ~password)
password_hash password_hash
| `Scrypt (password_hash, salt, params) -> | `Scrypt (password_hash, salt, params) ->
Cstruct.equal String.equal
(scrypt ~params ~salt ~password) (scrypt ~params ~salt ~password)
password_hash password_hash

2
auth/dune
View file

@ -1,3 +1,3 @@
(library (library
(name builder_web_auth) (name builder_web_auth)
(libraries pbkdf scrypt-kdf mirage-crypto-rng)) (libraries kdf.pbkdf kdf.scrypt mirage-crypto-rng))

51
bin/builder_db_app.ml
View file

@ -17,7 +17,7 @@ let defer_foreign_keys =
"PRAGMA defer_foreign_keys = ON" "PRAGMA defer_foreign_keys = ON"
let build_artifacts_to_orphan = 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 {| SELECT a.sha256 FROM build_artifact a
WHERE a.build = ? AND WHERE a.build = ? AND
(SELECT COUNT(*) FROM build_artifact a2 (SELECT COUNT(*) FROM build_artifact a2
@ -45,7 +45,7 @@ let migrate () dbpath =
let artifacts_dir datadir = Fpath.(datadir / "_artifacts") let artifacts_dir datadir = Fpath.(datadir / "_artifacts")
let artifact_path sha256 = 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: [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 (* 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 workaround for inferior filesystems. We can easily revert this by changing
@ -108,7 +108,7 @@ let user_disable () dbpath username =
match user with match user with
| None -> Error (`Msg "user not found") | None -> Error (`Msg "user not found")
| Some (_, user_info) -> | 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 let user_info = { user_info with password_hash ; restricted = true } in
Db.exec Builder_db.User.update_user user_info Db.exec Builder_db.User.update_user user_info
in in
@ -296,12 +296,12 @@ let vacuum () datadir platform_opt jobnames predicate =
or_die 1 r or_die 1 r
let input_ids = 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" "SELECT DISTINCT input_id FROM build WHERE input_id IS NOT NULL"
let main_artifact_hash = let main_artifact_hash =
Builder_db.Rep.cstruct ->* Caqti_type.octets ->*
Caqti_type.t3 Builder_db.Rep.cstruct Builder_db.Rep.uuid Caqti_type.string @@ 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 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 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 match hashes with
| (h, uuid, jobname) :: tl -> | (h, uuid, jobname) :: tl ->
List.iter (fun (h', uuid', _) -> List.iter (fun (h', uuid', _) ->
if Cstruct.equal h h' then if String.equal h h' then
() ()
else else
Logs.warn (fun m -> m "job %s input id %a with two different hashes (%a, %a), build %a and %a" 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 jobname Ohex.pp input_id
Cstruct.hexdump_pp h Cstruct.hexdump_pp h' Ohex.pp h Ohex.pp h'
Uuidm.pp uuid Uuidm.pp uuid')) Uuidm.pp uuid Uuidm.pp uuid'))
tl tl
| [] -> ()) | [] -> ())
@ -336,10 +336,9 @@ let num_build_artifacts =
Caqti_type.unit ->! Caqti_type.int @@ Caqti_type.unit ->! Caqti_type.int @@
"SELECT count(*) FROM build_artifact" "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.unit ->*
Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath Caqti_type.(t5 string Builder_db.Rep.uuid Builder_db.Rep.fpath octets int64)
Builder_db.Rep.cstruct int64)
@@ @@
{| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size {| SELECT job.name, b.uuid, a.filepath, a.sha256, a.size
FROM build_artifact a, build b, job 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; files_tracked := FpathSet.add (artifact_path sha256) !files_tracked;
let s = Int64.of_int (String.length data) in 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); 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 let sha256' = Digestif.SHA256.(to_raw_string (digest_string data)) in
if not (Cstruct.equal sha256 sha256') then if not (String.equal sha256 sha256') then
Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)" Logs.err (fun m -> m "File %a has different hash (in DB %a on disk %a)"
Fpath.pp abs_path Fpath.pp abs_path
Hex.pp (Hex.of_cstruct sha256) Ohex.pp sha256
Hex.pp (Hex.of_cstruct sha256'))) ; Ohex.pp sha256')) ;
Ok () Ok ()
else else
Ok () Ok ()
@ -545,8 +544,8 @@ module Verify_cache_dir = struct
type t = { type t = {
uuid : Uuidm.t; uuid : Uuidm.t;
job_name : string; job_name : string;
hash_opam_switch : Cstruct.t option; hash_opam_switch : string option;
hash_debug_bin : Cstruct.t option; hash_debug_bin : string option;
} }
let repr = let repr =
@ -560,8 +559,8 @@ module Verify_cache_dir = struct
t4 t4
Builder_db.Rep.uuid Builder_db.Rep.uuid
string string
(option Builder_db.Rep.cstruct) (option octets)
(option Builder_db.Rep.cstruct)) (option octets))
end end
@ -587,7 +586,7 @@ module Verify_cache_dir = struct
let* latest_version = let* latest_version =
Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ Viz_aux.get_viz_version_from_dirs ~cachedir ~viz_typ
in in
let `Hex viz_input_hash = Hex.of_cstruct hash in let viz_input_hash = Ohex.encode hash in
let* viz_path = let* viz_path =
Viz_aux.choose_versioned_viz_path Viz_aux.choose_versioned_viz_path
~cachedir ~cachedir
@ -667,7 +666,7 @@ module Verify_cache_dir = struct
match extract_hash ~viz_typ build with match extract_hash ~viz_typ build with
| None -> () | None -> ()
| Some input_hash -> | 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 let viz_path = Viz_aux.viz_path
~cachedir ~cachedir
~viz_typ ~viz_typ
@ -741,8 +740,8 @@ end
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, cs) -> | Ok (a, rest) ->
if Cstruct.length cs = 0 if String.length rest = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -808,8 +807,8 @@ let extract_full () datadir dest uuid =
artifacts artifacts
in in
let exec = (job, uuid, out, start, finish, result, data) in let exec = (job, uuid, out, start, finish, result, data) in
let cs = Builder.Asn.exec_to_cs exec in let data = Builder.Asn.exec_to_str exec in
Bos.OS.File.write (Fpath.v dest) (Cstruct.to_string cs) Bos.OS.File.write (Fpath.v dest) data
in in
or_die 1 r or_die 1 r

2
bin/builder_web_app.ml
View file

@ -30,7 +30,7 @@ let write_raw s buf =
safe_close s >|= fun () -> safe_close s >|= fun () ->
Error `Exception) Error `Exception)
in in
(* Logs.debug (fun m -> m "writing %a" Cstruct.hexdump_pp (Cstruct.of_bytes buf)) ; *) (* Logs.debug (fun m -> m "writing %a" (Ohex.pp_hexdump ()) (Bytes.unsafe_to_string buf)) ; *)
w 0 (Bytes.length buf) w 0 (Bytes.length buf)
let process = let process =

10
bin/migrations/m20210706.ml
View file

@ -57,9 +57,9 @@ let builds =
Caqti_type.unit ->* Caqti_type.unit ->*
Caqti_type.t4 Caqti_type.t4
Builder_db.Rep.untyped_id Builder_db.Rep.untyped_id
Builder_db.Rep.cstruct Caqti_type.octets
Builder_db.Rep.cstruct Caqti_type.octets
Builder_db.Rep.cstruct @@ Caqti_type.octets @@
{| SELECT b.id, opam.sha256, env.sha256, system.sha256 {| SELECT b.id, opam.sha256, env.sha256, system.sha256
FROM build b, build_artifact opam, build_artifact env, build_artifact system FROM build b, build_artifact opam, build_artifact env, build_artifact system
WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment' WHERE opam.filepath = 'opam-switch' AND env.filepath = 'build-environment'
@ -68,7 +68,7 @@ let builds =
|} |}
let set_input_id = 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" "UPDATE build SET input_id = $2 WHERE id = $1"
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = 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.exec add_input_id_to_build () >>= fun () ->
Db.collect_list builds () >>= fun builds -> Db.collect_list builds () >>= fun builds ->
Grej.list_iter_result (fun (id, opam_sha, env_sha, pkg_sha) -> 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
hannes marked this conversation as resolved
reynir commented 2024-09-04 06:16:40 +00:00
Review
Copy link

I like this! We now avoid allocating an intermediate string :D

I like this! We now avoid allocating an intermediate string :D
Db.exec set_input_id (id, input_id)) Db.exec set_input_id (id, input_id))
builds >>= fun () -> builds >>= fun () ->
Db.exec (Grej.set_version new_version) () Db.exec (Grej.set_version new_version) ()

7
bin/migrations/m20210707c.ml
View file

@ -16,8 +16,8 @@ let update_paths : ([`build_artifact] Builder_db.Rep.id * Fpath.t * Fpath.t, uni
Caqti_type.unit @@ Caqti_type.unit @@
"UPDATE build_artifact SET localpath = $2, filepath = $3 WHERE id = $1" "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 = 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 Builder_db.Rep.cstruct) Caqti_type.(t2 (t3 Builder_db.Rep.fpath Builder_db.Rep.fpath Caqti_type.octets)
(t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->. (t2 Caqti_type.int64 (Builder_db.Rep.id `build))) ->.
Caqti_type.unit @@ Caqti_type.unit @@
"INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)" "INSERT INTO build_artifact (filepath, localpath, sha256, size, build) VALUES (?, ?, ?, ?, ?)"
@ -48,7 +48,8 @@ let fixup datadir (module Db : Caqti_blocking.CONNECTION) =
in in
assert (r = 0); assert (r = 0);
Bos.OS.File.read (Fpath.append datadir artifact_lpath) >>= fun data -> 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 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.exec add_artifact ((artifact_fpath, artifact_lpath, sha256), (size, build_id)) >>= fun () ->
Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id -> Db.find Builder_db.last_insert_rowid () >>= fun new_build_artifact_id ->

8
bin/migrations/m20210712c.ml
View file

@ -8,8 +8,8 @@ open Grej.Infix
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, cs) -> | Ok (a, rest) ->
if Cstruct.length cs = 0 if String.length rest = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -96,7 +96,7 @@ let copy_from_new_build =
let old_build_console_script = let old_build_console_script =
Caqti_type.unit ->* Caqti_type.unit ->*
Caqti_type.(t4 (Builder_db.Rep.id (`build : [ `build ])) 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" "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 = let update_new_build_console_script =
@ -112,7 +112,7 @@ let new_build_console_script =
"SELECT id, console, script FROM build" "SELECT id, console, script FROM build"
let update_old_build_console_script = 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 @@ Caqti_type.unit @@
"UPDATE new_build SET console = $2, script = $3 WHERE id = $1" "UPDATE new_build SET console = $2, script = $3 WHERE id = $1"

16
builder-web.opam
View file

@ -17,18 +17,16 @@ build: [
depends: [ depends: [
"ocaml" {>= "4.13.0"} "ocaml" {>= "4.13.0"}
"dune" {>= "2.7.0"} "dune" {>= "2.7.0"}
"builder" {>= "0.2.0"} "builder" {>= "0.4.0"}
"dream" {>= "1.0.0~alpha4"} "dream" {>= "1.0.0~alpha7"}
"cstruct" {>= "6.0.0"}
"bos" "bos"
"hex" "ohex" {>= "0.2.0"}
"lwt" {>= "5.7.0"} "lwt" {>= "5.7.0"}
"caqti" {>= "2.1.1"} "caqti" {>= "2.1.2"}
"caqti-lwt" "caqti-lwt"
"caqti-driver-sqlite3" "caqti-driver-sqlite3"
"pbkdf"
"mirage-crypto-rng" {>= "0.11.0"} "mirage-crypto-rng" {>= "0.11.0"}
"scrypt-kdf" "kdf"
"opam-core" "opam-core"
"opam-format" {>= "2.1.0"} "opam-format" {>= "2.1.0"}
"metrics" {>= "0.3.0"} "metrics" {>= "0.3.0"}
@ -39,8 +37,7 @@ depends: [
"tyxml" {>= "4.3.0"} "tyxml" {>= "4.3.0"}
"ptime" "ptime"
"duration" "duration"
"mirage-crypto" "asn1-combinators" {>= "0.3.0"}
"asn1-combinators"
"logs" "logs"
"cmdliner" {>= "1.1.0"} "cmdliner" {>= "1.1.0"}
"uri" "uri"
@ -51,6 +48,7 @@ depends: [
"owee" "owee"
"solo5-elftool" {>= "0.3.0"} "solo5-elftool" {>= "0.3.0"}
"decompress" {>= "1.5.0"} "decompress" {>= "1.5.0"}
"digestif" {>= "1.2.0"}
"alcotest" {>= "1.2.0" & with-test} "alcotest" {>= "1.2.0" & with-test}
"ppx_deriving" {with-test} "ppx_deriving" {with-test}
"ppx_deriving_yojson" {with-test} "ppx_deriving_yojson" {with-test}

24
db/builder_db.ml
View file

@ -12,7 +12,7 @@ type 'a id = 'a Rep.id
type file = Rep.file = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : Cstruct.t; sha256 : string;
size : int; size : int;
} }
@ -172,7 +172,7 @@ module Build_artifact = struct
"SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?" "SELECT id, filepath, sha256, size FROM build_artifact WHERE build = ?"
let exists = let exists =
cstruct ->! Caqti_type.bool @@ Caqti_type.octets ->! Caqti_type.bool @@
"SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)" "SELECT EXISTS(SELECT 1 FROM build_artifact WHERE sha256 = ?)"
let add = let add =
@ -199,7 +199,7 @@ module Build = struct
script : Fpath.t; script : Fpath.t;
platform : string; platform : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option; input_id : string option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -224,7 +224,7 @@ module Build = struct
Fpath.pp t.script Fpath.pp t.script
t.platform t.platform
Fmt.(Dump.option int64) t.main_binary 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.user_id
t.job_id t.job_id
@ -240,7 +240,7 @@ module Build = struct
fpath fpath
string string
(option (Rep.id `build_artifact)) (option (Rep.id `build_artifact))
(option Rep.cstruct) (option octets)
(id `user) (id `user)
(id `job)) (id `job))
in in
@ -314,7 +314,7 @@ module Build = struct
|} |}
let get_all_artifact_sha = 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 {| SELECT DISTINCT a.sha256
FROM build_artifact a, build b FROM build_artifact a, build b
WHERE b.job = $1 AND b.main_binary = a.id WHERE b.job = $1 AND b.main_binary = a.id
@ -446,7 +446,7 @@ module Build = struct
|} |}
let get_same_input_different_output_hashes = let get_same_input_different_output_hashes =
id `build ->* Rep.cstruct @@ id `build ->* Caqti_type.octets @@
{| SELECT DISTINCT a.sha256 {| SELECT DISTINCT a.sha256
FROM build b0, build_artifact a0, build b, build_artifact a 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 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 = let get_different_input_same_output_input_ids =
id `build ->* Rep.cstruct @@ id `build ->* Caqti_type.octets @@
{| SELECT DISTINCT b.input_id {| SELECT DISTINCT b.input_id
FROM build b0, build_artifact a0, build b, build_artifact a 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 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 = let get_one_by_input_id =
Rep.cstruct ->! t @@ Caqti_type.octets ->! t @@
{| SELECT uuid, start_d, start_ps, finish_d, finish_ps, {| SELECT uuid, start_d, start_ps, finish_d, finish_ps,
result_code, result_msg, console, script, result_code, result_msg, console, script,
platform, main_binary, input_id, user, job platform, main_binary, input_id, user, job
@ -487,7 +487,7 @@ module Build = struct
|} |}
let get_by_hash = let get_by_hash =
Rep.cstruct ->! t @@ Caqti_type.octets ->! t @@
{| SELECT {| SELECT
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, 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.result_code, b.result_msg, b.console, b.script,
@ -500,7 +500,7 @@ module Build = struct
|} |}
let get_with_main_binary_by_hash = 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, {| 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.result_code, b.result_msg, b.console, b.script,
b.platform, b.main_binary, b.input_id, b.user, b.job, 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 = 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, {| SELECT job.name,
b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps, b.uuid, b.start_d, b.start_ps, b.finish_d, b.finish_ps,
b.result_code, b.result_msg, b.result_code, b.result_msg,

23
db/builder_db.mli
View file

@ -3,7 +3,7 @@ module Rep : sig
type 'a id type 'a id
type file = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : Cstruct.t; sha256 : string;
size : int; size : int;
} }
@ -13,7 +13,6 @@ module Rep : sig
val uuid : Uuidm.t Caqti_type.t val uuid : Uuidm.t Caqti_type.t
val ptime : Ptime.t Caqti_type.t val ptime : Ptime.t Caqti_type.t
val fpath : Fpath.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 file : file Caqti_type.t
val execution_result : Builder.execution_result Caqti_type.t val execution_result : Builder.execution_result Caqti_type.t
val console : (int * string) list 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 = { type file = Rep.file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : Cstruct.t; sha256 : string;
size : int; size : int;
} }
@ -85,7 +84,7 @@ module Build_artifact : sig
Caqti_request.t Caqti_request.t
val get_all_by_build : val get_all_by_build :
([`build] id, [`build_artifact] id * file, [ `Many | `One | `Zero ]) Caqti_request.t ([`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 : val add :
(file * [`build] id, unit, [ `Zero ]) Caqti_request.t (file * [`build] id, unit, [ `Zero ]) Caqti_request.t
val remove_by_build : val remove_by_build :
@ -105,7 +104,7 @@ sig
script : Fpath.t; script : Fpath.t;
platform : string; platform : string;
main_binary : [`build_artifact] id option; main_binary : [`build_artifact] id option;
input_id : Cstruct.t option; input_id : string option;
user_id : [`user] id; user_id : [`user] id;
job_id : [`job] id; job_id : [`job] id;
} }
@ -120,7 +119,7 @@ sig
val get_all_failed : val get_all_failed :
(int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t (int * int * string option, string * t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_all_artifact_sha : 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 : val get_latest_successful_with_binary :
([`job] id * string, [`build] id * t * file, [ `One | `Zero ]) ([`job] id * string, [`build] id * t * file, [ `One | `Zero ])
Caqti_request.t Caqti_request.t
@ -144,20 +143,20 @@ sig
val get_same_input_same_output_builds : val get_same_input_same_output_builds :
([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t ([`build] id, t, [ `Many | `One | `Zero ]) Caqti_request.t
val get_same_input_different_output_hashes : 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 : 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 : val get_one_by_input_id :
(Cstruct.t, t, [ `One ]) Caqti_request.t (string, t, [ `One ]) Caqti_request.t
val get_platforms_for_job : val get_platforms_for_job :
([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t ([`job] id, string, [ `Many | `One | `Zero ]) Caqti_request.t
val add : (t, unit, [ `Zero ]) Caqti_request.t val add : (t, unit, [ `Zero ]) Caqti_request.t
val get_by_hash : val get_by_hash :
(Cstruct.t, t, [ `One]) Caqti_request.t (string, t, [ `One]) Caqti_request.t
val get_with_main_binary_by_hash : 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 : 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 set_main_binary : ([`build] id * [`build_artifact] id, unit, [ `Zero ]) Caqti_request.t
val remove : ([`build] id, unit, [ `Zero]) Caqti_request.t val remove : ([`build] id, unit, [ `Zero]) Caqti_request.t
end end

3
db/dune
View file

@ -1,4 +1,3 @@
(library (library
(name builder_db) (name builder_db)
(libraries builder caqti caqti-driver-sqlite3 asn1-combinators mirage-crypto (libraries builder caqti caqti-driver-sqlite3 asn1-combinators builder_web_auth))
builder_web_auth))

25
db/representation.ml
View file

@ -1,8 +1,8 @@
module Asn = struct module Asn = struct
let decode_strict codec cs = let decode_strict codec cs =
match Asn.decode codec cs with match Asn.decode codec cs with
| Ok (a, cs) -> | Ok (a, rest) ->
if Cstruct.length cs = 0 if String.length rest = 0
then Ok a then Ok a
else Error "trailing bytes" else Error "trailing bytes"
| Error (`Parse msg) -> Error ("parse error: " ^ msg) | Error (`Parse msg) -> Error ("parse error: " ^ msg)
@ -17,7 +17,7 @@ module Asn = struct
(required ~label:"delta" int) (required ~label:"delta" int)
(required ~label:"data" utf8_string))) (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 end
type untyped_id = int64 type untyped_id = int64
@ -30,7 +30,7 @@ let id_to_int64 (id : 'a id) : int64 = id
type file = { type file = {
filepath : Fpath.t; filepath : Fpath.t;
sha256 : Cstruct.t; sha256 : string;
size : int; size : int;
} }
@ -56,20 +56,15 @@ let fpath =
|> Result.map_error (fun (`Msg s) -> s) in |> Result.map_error (fun (`Msg s) -> s) in
Caqti_type.custom ~encode ~decode Caqti_type.string 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 file =
let encode { filepath; sha256; size } = let encode { filepath; sha256; size } =
Ok (filepath, sha256, size) in Ok (filepath, sha256, size) in
let decode (filepath, sha256, size) = let decode (filepath, sha256, size) =
Ok { filepath; sha256; size } in 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 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 let encode = function
| Some { filepath; sha256; size } -> | Some { filepath; sha256; size } ->
Ok (Some filepath, Some sha256, Some size) Ok (Some filepath, Some sha256, Some size)
@ -112,12 +107,12 @@ let execution_result =
Caqti_type.custom ~encode ~decode rep Caqti_type.custom ~encode ~decode rep
let console = let console =
let encode console = Ok (Asn.console_to_cs console) in let encode console = Ok (Asn.console_to_str console) in
let decode data = Asn.console_of_cs data in let decode data = Asn.console_of_str data in
Caqti_type.custom ~encode ~decode cstruct Caqti_type.(custom ~encode ~decode octets)
let user_info = 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; let encode { Builder_web_auth.username;
password_hash = `Scrypt (password_hash, password_salt, { password_hash = `Scrypt (password_hash, password_salt, {
Builder_web_auth.scrypt_n; scrypt_r; scrypt_p Builder_web_auth.scrypt_n; scrypt_r; scrypt_p

14
lib/builder_web.ml
View file

@ -199,10 +199,6 @@ module Viz_aux = struct
let hash_viz_input ~uuid typ db = let hash_viz_input ~uuid typ db =
let open Builder_db in 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 -> main_binary_of_uuid uuid db >>= fun main_binary ->
Model.build uuid db Model.build uuid db
|> if_error "Error getting build" >>= fun (build_id, _build) -> |> if_error "Error getting build" >>= fun (build_id, _build) ->
@ -220,7 +216,7 @@ module Viz_aux = struct
Model.not_found debug_binary Model.not_found debug_binary
|> not_found_error >>= fun debug_binary -> |> not_found_error >>= fun debug_binary ->
debug_binary.sha256 debug_binary.sha256
|> hex |> Ohex.encode
|> Lwt_result.return |> Lwt_result.return
end end
| `Dependencies -> | `Dependencies ->
@ -232,7 +228,7 @@ module Viz_aux = struct
Model.not_found opam_switch Model.not_found opam_switch
|> not_found_error >>= fun opam_switch -> |> not_found_error >>= fun opam_switch ->
opam_switch.sha256 opam_switch.sha256
|> hex |> Ohex.encode
|> Lwt_result.return |> Lwt_result.return
let try_load_cached_visualization ~cachedir ~uuid viz_typ db = 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 -> |> if_error ~status:`Not_Found "File not found" >>= fun filepath ->
Dream.sql req (Model.build_artifact build filepath) Dream.sql req (Model.build_artifact build filepath)
|> if_error "Error getting build artifact" >>= fun file -> |> 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 match if_none_match with
| Some etag' when etag = etag' -> | Some etag' when etag = etag' ->
Dream.empty `Not_Modified |> Lwt_result.ok Dream.empty `Not_Modified |> Lwt_result.ok
@ -498,7 +494,7 @@ let routes ~datadir ~cachedir ~configdir ~expired_jobs =
let upload req = let upload req =
let* body = Dream.body req in 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" |> if_error ~status:`Bad_Request "Bad request"
~log:(fun e -> ~log:(fun e ->
Log.warn (fun m -> m "Received bad builder ASN.1"); 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") Dream.query req "sha256" |> Option.to_result ~none:(`Msg "Missing sha256 query parameter")
|> Lwt.return |> Lwt.return
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash_hex -> |> 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)) with Invalid_argument e -> Lwt_result.fail (`Msg ("Bad hex: " ^ e))
end end
|> if_error ~status:`Bad_Request "Bad request" >>= fun hash -> |> if_error ~status:`Bad_Request "Bad request" >>= fun hash ->

4
lib/dune
View file

@ -1,5 +1,5 @@
(library (library
(name builder_web) (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 opamdiff ptime.clock.os cmarkit tar tar.gz tar-unix owee solo5-elftool decompress.de
decompress.gz uri)) decompress.gz uri digestif))

13
lib/model.ml
View file

@ -20,7 +20,7 @@ let not_found = function
let staging datadir = Fpath.(datadir / "_staging") let staging datadir = Fpath.(datadir / "_staging")
let artifact_path artifact = 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: [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 (* 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 workaround for inferior filesystems. We can easily revert this by changing
@ -221,7 +221,7 @@ let save_artifacts staging artifacts =
List.fold_left List.fold_left
(fun r (file, data) -> (fun r (file, data) ->
r >>= fun () -> 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 let destpath = Fpath.(staging / sha256) in
save destpath data) save destpath data)
(Lwt_result.return ()) (Lwt_result.return ())
@ -232,7 +232,7 @@ let commit_files datadir staging_dir job_name uuid artifacts =
List.fold_left List.fold_left
(fun r artifact -> (fun r artifact ->
r >>= fun () -> 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 src = Fpath.(staging_dir / sha256) in
let dest = Fpath.(datadir // artifact_path artifact) in let dest = Fpath.(datadir // artifact_path artifact) in
Lwt.return (Bos.OS.Dir.create (Fpath.parent dest)) >>= fun _created -> 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 "build-environment"),
get_hash (Fpath.v "system-packages") get_hash (Fpath.v "system-packages")
with 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 | _ -> None
let save_console_and_script staging_dir job_name uuid console script = let save_console_and_script staging_dir job_name uuid console script =
@ -377,7 +378,7 @@ let add_build
if not_interesting filepath then if not_interesting filepath then
Lwt_result.return acc Lwt_result.return acc
else 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 and size = String.length data in
Lwt_result.ok (Lwt.pause ()) >|= fun () -> Lwt_result.ok (Lwt.pause ()) >|= fun () ->
({ filepath; sha256; size }, data) :: acc) ({ filepath; sha256; size }, data) :: acc)
@ -483,7 +484,7 @@ let add_build
and uuid = Uuidm.to_string uuid and uuid = Uuidm.to_string uuid
and job = job.name and job = job.name
and platform = job.platform and platform = job.platform
and `Hex sha256 = Hex.of_cstruct main_binary.sha256 and sha256 = Ohex.encode main_binary.sha256
in in
let fp_str p = Fpath.(to_string (datadir // p)) in let fp_str p = Fpath.(to_string (datadir // p)) in
let args = let args =

2
lib/model.mli
View file

@ -33,7 +33,7 @@ val build : Uuidm.t -> Caqti_lwt.connection ->
val build_with_main_binary : [`job] Builder_db.id -> string -> 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 ((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 ((string * Builder_db.Build.t) option, [> Caqti_error.call_or_retrieve ]) result Lwt.t
val build_exists : Uuidm.t -> Caqti_lwt.connection -> val build_exists : Uuidm.t -> Caqti_lwt.connection ->

4
lib/views.ml
View file

@ -202,7 +202,7 @@ let artifact
else txtf "%a" Fpath.pp filepath else txtf "%a" Fpath.pp filepath
]; ];
H.txt " "; 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; txtf " (%a)" Fmt.byte_size size;
] ]
@ -491,7 +491,7 @@ module Job_build = struct
pp_devices block_devices pp_devices net_devices] pp_devices block_devices pp_devices net_devices]
in in
let aux (file:Builder_db.file) = 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.dt [
H.a ~a:H.[a_href @@ Link.Job_build_artifact.make H.a ~a:H.[a_href @@ Link.Job_build_artifact.make

2
test/dune
View file

@ -1,7 +1,7 @@
(test (test
(name test_builder_db) (name test_builder_db)
(modules 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 (test
(name markdown_to_html) (name markdown_to_html)

7
test/router.ml
View file

@ -165,10 +165,9 @@ let () =
.. to find them I follewed the trails of 'Albatross_cli.http_host' .. to find them I follewed the trails of 'Albatross_cli.http_host'
*) *)
begin begin
let `Hex sha_str = let sha_str =
Cstruct.of_string "foo" Digestif.SHA256.(to_raw_string (digest_string "foo"))
|> Mirage_crypto.Hash.SHA256.digest |> Ohex.encode
|> Hex.of_cstruct
in in
Fmt.str "/hash?sha256=%s" sha_str Fmt.str "/hash?sha256=%s" sha_str
end; end;

14
test/test_builder_db.ml
View file

@ -25,8 +25,8 @@ module Testable = struct
x.restricted = y.restricted && x.restricted = y.restricted &&
match x.password_hash, y.password_hash with match x.password_hash, y.password_hash with
| `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') -> | `Scrypt (hash, salt, params), `Scrypt (hash', salt', params') ->
Cstruct.equal hash hash' && String.equal hash hash' &&
Cstruct.equal salt salt' && String.equal salt salt' &&
params = params' params = params'
in in
let pp ppf { Builder_web_auth.username; password_hash; restricted } = 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 }) -> | `Scrypt (hash, salt, { Builder_web_auth.scrypt_n; scrypt_r; scrypt_p }) ->
Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username Format.fprintf ppf "user:%s;(%d,%d,%d);%B;%a;%a" username
scrypt_n scrypt_r scrypt_p restricted scrypt_n scrypt_r scrypt_p restricted
Cstruct.hexdump_pp hash Cstruct.hexdump_pp salt Ohex.pp hash Ohex.pp salt
in in
Alcotest.testable Alcotest.testable
pp pp
@ -43,7 +43,7 @@ module Testable = struct
let file = let file =
let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) = let equal (x : Builder_db.Rep.file) (y : Builder_db.Rep.file) =
Fpath.equal x.filepath y.filepath && Fpath.equal x.filepath y.filepath &&
Cstruct.equal x.sha256 y.sha256 && String.equal x.sha256 y.sha256 &&
x.size = y.size x.size = y.size
in in
let pp ppf { Builder_db.Rep.filepath; sha256; size } = let pp ppf { Builder_db.Rep.filepath; sha256; size } =
@ -51,7 +51,7 @@ module Testable = struct
sha256 = %a;@;<1 0>\ sha256 = %a;@;<1 0>\
size = %d;@;<1 0>\ size = %d;@;<1 0>\
@]@,}" @]@,}"
Fpath.pp filepath Cstruct.hexdump_pp sha256 size Fpath.pp filepath Ohex.pp sha256 size
in in
Alcotest.testable pp equal Alcotest.testable pp equal
@ -131,12 +131,12 @@ let result = Builder.Exited 0
let main_binary = let main_binary =
let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in let filepath = Result.get_ok (Fpath.of_string "bin/hello.sh") in
let data = "#!/bin/sh\necho Hello, World\n" 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 let size = String.length data in
{ Builder_db.Rep.filepath; sha256; size } { Builder_db.Rep.filepath; sha256; size }
let main_binary2 = let main_binary2 =
let data = "#!/bin/sh\necho Hello, World 2\n" in 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 let size = String.length data in
{ main_binary with sha256 ; size } { main_binary with sha256 ; size }
let platform = "exotic-os" let platform = "exotic-os"