From 86fc93076b38444dc030dd6570399cc35849dae0 Mon Sep 17 00:00:00 2001 From: Marc Biedermann Date: Mon, 24 Feb 2025 17:21:02 +0100 Subject: [PATCH 1/4] update packages for ocaml --- .devcontainer/Dockerfile | 5 +- .devcontainer/postCreate.sh | 3 +- guardian.opam | 2 +- guardian.opam.locked | 109 ++++++++++++++++++++---------------- 4 files changed, 67 insertions(+), 52 deletions(-) diff --git a/.devcontainer/Dockerfile b/.devcontainer/Dockerfile index 1f428be..a5668cf 100644 --- a/.devcontainer/Dockerfile +++ b/.devcontainer/Dockerfile @@ -1,6 +1,6 @@ FROM node:lts AS node FROM hadolint/hadolint:latest-alpine AS hadolint -FROM ocaml/opam:debian-12-ocaml-4.14 +FROM ocaml/opam:debian-12-ocaml-5.3 USER root @@ -45,6 +45,9 @@ RUN ln -fs /usr/share/zoneinfo/Europe/Zurich /etc/localtime RUN bash -c 'echo "http 80/tcp www # WorldWideWeb HTTP" >> /etc/services' \ && bash -c 'echo "https 443/tcp www # WorldWideWeb HTTPS" >> /etc/services' +# link opam version +RUN ln -fs /usr/bin/opam-2.3 /usr/bin/opam + USER opam # install oh-my-zsh diff --git a/.devcontainer/postCreate.sh b/.devcontainer/postCreate.sh index 1de57bf..799698d 100755 --- a/.devcontainer/postCreate.sh +++ b/.devcontainer/postCreate.sh @@ -9,7 +9,6 @@ opam init -a --shell=zsh opam remote remove --all default opam repository add default --all-switches --set-default https://opam.ocaml.org -opam pin add -yn guardian . -opam depext --with-test --with-doc -y guardian +opam install --with-test --with-doc --deps-only -y . make deps diff --git a/guardian.opam b/guardian.opam index c81bbb8..e4d0a3a 100644 --- a/guardian.opam +++ b/guardian.opam @@ -21,7 +21,7 @@ depends: [ "logs" {>= "0.7.0"} "lwt" {>= "5.6.1"} "lwt_ppx" {>= "2.1.0"} - "mariadb" {>= "1.1.6"} + "mariadb" {>= "1.2.0"} "ocaml" {>= "4.12.0"} "ppx_deriving" {>= "5.2.1"} "ppx_deriving_yojson" {>= "3.6.1"} diff --git a/guardian.opam.locked b/guardian.opam.locked index 51f6b9a..221298f 100644 --- a/guardian.opam.locked +++ b/guardian.opam.locked @@ -12,94 +12,111 @@ homepage: "https://github.com/uzh/guardian" doc: "https://uzh.github.io/guardian" bug-reports: "https://github.com/uzh/guardian/issues" depends: [ + "alcotest" {= "1.8.0" & with-test} + "alcotest-lwt" {= "1.8.0" & with-test} "angstrom" {= "0.16.1"} "asn1-combinators" {= "0.3.2"} - "base" {= "v0.16.3"} + "astring" {= "0.8.5" & with-test} + "base" {= "v0.17.1"} "base-bigarray" {= "base"} "base-bytes" {= "base"} + "base-domains" {= "base"} + "base-effects" {= "base"} + "base-nnp" {= "base"} "base-threads" {= "base"} "base-unix" {= "base"} "base64" {= "3.5.1"} "bigarray-compat" {= "1.1.0"} "bigstringaf" {= "0.10.0"} + "camlp-streams" {= "5.0.1" & with-doc} "caqti" {= "2.1.2"} "caqti-driver-mariadb" {= "2.1.1"} "caqti-lwt" {= "2.1.1"} "cmdliner" {= "1.3.0"} - "conf-bash" {= "1"} "conf-gcc" {= "1.0"} "conf-gmp" {= "4"} "conf-gmp-powm-sec" {= "3"} "conf-mariadb" {= "2"} - "conf-pkg-config" {= "3"} - "containers" {= "3.14"} - "containers-data" {= "3.14"} - "cppo" {= "1.7.0"} + "conf-pkg-config" {= "4"} + "containers" {= "3.15"} + "containers-data" {= "3.15"} + "cppo" {= "1.8.0"} + "crunch" {= "4.0.0" & with-doc} "csexp" {= "1.5.2"} - "ctypes" {= "0.20.2"} + "ctypes" {= "0.23.0"} "digestif" {= "1.2.0"} - "domain-name" {= "0.4.0"} - "dune" {= "3.16.0"} - "dune-configurator" {= "3.16.0"} - "dune-private-libs" {= "3.16.0"} - "dune-site" {= "3.16.0"} + "domain-name" {= "0.4.1"} + "dune" {= "3.17.2"} + "dune-configurator" {= "3.17.2"} + "dune-private-libs" {= "3.17.2"} + "dune-site" {= "3.17.2"} "duration" {= "0.2.1"} - "dyn" {= "3.16.0"} + "dyn" {= "3.17.2"} "either" {= "1.0.0"} "eqaf" {= "0.10"} - "fieldslib" {= "v0.16.0"} + "fieldslib" {= "v0.17.0"} "fmt" {= "0.9.0"} + "fpath" {= "0.7.3" & with-doc} "gmap" {= "0.3.0"} - "host-arch-arm64" {= "1"} - "host-system-other" {= "1"} "integers" {= "0.7.0"} "ipaddr" {= "5.6.0"} "kdf" {= "1.0.0"} "logs" {= "0.7.0"} - "lwt" {= "5.7.0"} + "lwt" {= "5.9.0"} "lwt-dllist" {= "1.0.1"} - "lwt_ppx" {= "2.1.0"} + "lwt_ppx" {= "5.8.0"} "macaddr" {= "5.6.0"} - "mariadb" {= "1.1.6"} - "mirage-crypto" {= "1.1.0"} - "mirage-crypto-ec" {= "1.1.0"} - "mirage-crypto-pk" {= "1.1.0"} - "mirage-crypto-rng" {= "1.1.0"} + "mariadb" {= "1.2.0"} + "mirage-crypto" {= "2.0.0"} + "mirage-crypto-ec" {= "2.0.0"} + "mirage-crypto-pk" {= "2.0.0"} + "mirage-crypto-rng" {= "2.0.0"} "mtime" {= "2.1.0"} - "ocaml" {= "4.14.2"} - "ocaml-base-compiler" {= "4.14.2"} - "ocaml-compiler-libs" {= "v0.12.4"} + "ocaml" {= "5.3.0"} + "ocaml-base-compiler" {= "5.3.0"} + "ocaml-compiler" {= "5.3.0"} + "ocaml-compiler-libs" {= "v0.17.0"} + "ocaml-config" {= "3"} + "ocaml-options-vanilla" {= "1"} "ocaml-syntax-shims" {= "1.0.0"} + "ocaml_intrinsics_kernel" {= "v0.17.1"} "ocamlbuild" {= "0.15.0"} - "ocamlfind" {= "1.9.6"} + "ocamlfind" {= "1.9.8"} "ocplib-endian" {= "1.2"} + "odoc" {= "2.4.4" & with-doc} + "odoc-parser" {= "2.4.4" & with-doc} "ohex" {= "0.2.0"} - "ordering" {= "3.16.0"} - "pp" {= "1.2.0"} - "ppx_base" {= "v0.16.0"} - "ppx_cold" {= "v0.16.0"} - "ppx_compare" {= "v0.16.0"} + "ordering" {= "3.17.2"} + "pp" {= "2.0.0"} + "ppx_base" {= "v0.17.0"} + "ppx_cold" {= "v0.17.0"} + "ppx_compare" {= "v0.17.0"} "ppx_derivers" {= "1.2.1"} "ppx_deriving" {= "6.0.3"} - "ppx_deriving_yojson" {= "3.9.0"} - "ppx_enumerate" {= "v0.16.0"} - "ppx_fields_conv" {= "v0.16.0"} - "ppx_globalize" {= "v0.16.0"} - "ppx_hash" {= "v0.16.0"} - "ppx_sexp_conv" {= "v0.16.0"} - "ppx_string" {= "v0.16.0"} - "ppxlib" {= "0.33.0"} + "ppx_deriving_yojson" {= "3.9.1"} + "ppx_enumerate" {= "v0.17.0"} + "ppx_fields_conv" {= "v0.17.0"} + "ppx_globalize" {= "v0.17.0"} + "ppx_hash" {= "v0.17.0"} + "ppx_sexp_conv" {= "v0.17.0"} + "ppx_string" {= "v0.17.0"} + "ppxlib" {= "0.35.0"} + "ppxlib_jane" {= "v0.17.2"} "ptime" {= "1.2.0"} + "re" {= "1.12.0" & with-test} + "result" {= "1.5" & with-doc} "seq" {= "base"} - "sexplib0" {= "v0.16.0"} + "sexplib0" {= "v0.17.0"} "stdlib-shims" {= "0.3.0"} - "stdune" {= "3.16.0"} + "stdune" {= "3.17.2"} "stringext" {= "1.6.0"} - "tls" {= "1.0.2"} + "tls" {= "2.0.0"} "topkg" {= "1.0.7"} + "tyxml" {= "4.6.0" & with-doc} "uri" {= "4.4.0"} "uuidm" {= "0.9.9"} - "x509" {= "1.0.4"} + "uutf" {= "1.0.3" & with-test} + "x509" {= "1.0.5"} "yojson" {= "2.2.2"} "zarith" {= "1.14"} ] @@ -121,7 +138,3 @@ build: [ ] dev-repo: "git+https://github.com/uzh/guardian.git" name: "guardian" -pin-depends: [ - "ocaml-base-compiler.4.14.2" - "https://github.com/ocaml/ocaml/archive/4.14.2.tar.gz" -] From 2437a9c927dbba8aba5bd06f72e230667bd3ad73 Mon Sep 17 00:00:00 2001 From: Marc Biedermann Date: Mon, 24 Feb 2025 17:21:14 +0100 Subject: [PATCH 2/4] run formatter --- backend/database_pools.ml | 57 +++++++------- backend/mariadb_backend.ml | 62 +++++++-------- backend/mariadb_utils.ml | 12 +-- lib/guardian_entity.ml | 157 ++++++++++++++++++------------------- lib/role_set.ml | 2 +- test/article.ml | 10 +-- test/main.ml | 14 ++-- 7 files changed, 156 insertions(+), 158 deletions(-) diff --git a/backend/database_pools.ml b/backend/database_pools.ml index ddb836e..3e3c633 100644 --- a/backend/database_pools.ml +++ b/backend/database_pools.ml @@ -70,23 +70,23 @@ module Make (Config : ConfigSig) = struct ;; let connect - ?(retries = 2) - ({ database_label; database_url; required; _ } as pool) + ?(retries = 2) + ({ database_label; database_url; required; _ } as pool) = let tags = database_label |> LogTag.create in CCResult.retry retries (fun () -> database_url |> connect_pool) |> (function - | Error [] -> raise (Exception "Failed to connect: empty error") - | Error (err :: _) when required -> raise (Caqti_error.Exn err) - | Error (err :: _ as errors) -> - Logs.warn ~src (fun m -> - m - ~tags - "Failed to connect: %s (%s)" - database_label - ([%show: Caqti_error.t list] errors)); - Fail err - | Ok con -> Open con) + | Error [] -> raise (Exception "Failed to connect: empty error") + | Error (err :: _) when required -> raise (Caqti_error.Exn err) + | Error (err :: _ as errors) -> + Logs.warn ~src (fun m -> + m + ~tags + "Failed to connect: %s (%s)" + database_label + ([%show: Caqti_error.t list] errors)); + Fail err + | Ok con -> Open con) |> fun connection -> { pool with connection } ;; end @@ -293,13 +293,14 @@ module Make (Config : ConfigSig) = struct ;; let transaction - ?ctx - ?(setup : (Caqti_lwt.connection -> (unit, Caqti_error.t) Lwt_result.t) list = - []) - ?(cleanup : - (Caqti_lwt.connection -> (unit, Caqti_error.t) Lwt_result.t) list = - []) - (f : Caqti_lwt.connection -> ('a, Caqti_error.t) Lwt_result.t) + ?ctx + ?(setup : + (Caqti_lwt.connection -> (unit, Caqti_error.t) Lwt_result.t) list = + []) + ?(cleanup : + (Caqti_lwt.connection -> (unit, Caqti_error.t) Lwt_result.t) list = + []) + (f : Caqti_lwt.connection -> ('a, Caqti_error.t) Lwt_result.t) : 'a Lwt.t = let open Lwt_result.Syntax in @@ -308,12 +309,12 @@ module Make (Config : ConfigSig) = struct let* () = Connection.start () in Lwt.catch (fun () -> - let* () = exec_each connection setup in - let* result = f connection in - let* () = exec_each connection cleanup in - match%lwt Connection.commit () with - | Ok () -> Lwt.return_ok result - | Error error -> Lwt.return_error error) + let* () = exec_each connection setup in + let* result = f connection in + let* () = exec_each connection cleanup in + match%lwt Connection.commit () with + | Ok () -> Lwt.return_ok result + | Error error -> Lwt.return_error error) (rollback ?ctx connection)) |> map_fetched ?ctx ;; @@ -325,8 +326,8 @@ module Make (Config : ConfigSig) = struct let* () = Connection.start () in Lwt.catch (fun () -> - let* () = exec_each connection queries in - Connection.commit ()) + let* () = exec_each connection queries in + Connection.commit ()) (rollback ?ctx connection)) |> map_fetched ?ctx ;; diff --git a/backend/mariadb_backend.ml b/backend/mariadb_backend.ml index 40cb99f..4815abc 100644 --- a/backend/mariadb_backend.ml +++ b/backend/mariadb_backend.ml @@ -308,11 +308,11 @@ struct end let combine_sql - from_sql - std_filter_sql - ?(joins = "") - ?where_additions - select + from_sql + std_filter_sql + ?(joins = "") + ?where_additions + select = Format.asprintf "SELECT\n %s\nFROM %s\n %s\nWHERE\n %s\n %s" @@ -409,10 +409,10 @@ struct let find_by_target ?ctx = Database.collect ?ctx find_by_target_request let create_exclude - ?(field = "roles.actor_uuid") - ?(dynparam = Guardian.Utils.Dynparam.empty) - ?(with_uuid = false) - exclude + ?(field = "roles.actor_uuid") + ?(dynparam = Guardian.Utils.Dynparam.empty) + ?(with_uuid = false) + exclude = let open Guardian.Utils.Dynparam in if CCList.is_empty exclude @@ -421,22 +421,22 @@ struct let arguments, params = CCList.fold_left (fun (args, dyn) (role, target_uuid) -> - match target_uuid with - | None when with_uuid -> - ( "(exclude.role = ? AND exclude.target_uuid IS NULL)" - :: args - , dyn |> add Model.role role ) - | None -> - ( "exclude.role = ? AND exclude.target_uuid IS NULL" - :: args - , dyn |> add Model.role role ) - | Some uuid -> - ( [%string - {sql|(exclude.role = ? AND exclude.target_uuid = %{Entity.Uuid.sql_value_fragment "?"})|sql}] - :: args - , dyn - |> add Model.role role - |> add Entity.Uuid.Target.t uuid )) + match target_uuid with + | None when with_uuid -> + ( "(exclude.role = ? AND exclude.target_uuid IS NULL)" + :: args + , dyn |> add Model.role role ) + | None -> + ( "exclude.role = ? AND exclude.target_uuid IS NULL" + :: args + , dyn |> add Model.role role ) + | Some uuid -> + ( [%string + {sql|(exclude.role = ? AND exclude.target_uuid = %{Entity.Uuid.sql_value_fragment "?"})|sql}] + :: args + , dyn + |> add Model.role role + |> add Entity.Uuid.Target.t uuid )) ([], dynparam) exclude in @@ -1183,12 +1183,12 @@ struct ;; let validate - ?ctx - ?(any_id = false) - ?target_uuid - ?model - permission - { Guard.Actor.uuid; _ } + ?ctx + ?(any_id = false) + ?target_uuid + ?model + permission + { Guard.Actor.uuid; _ } = let open Lwt.Infix in (match any_id, target_uuid, model with diff --git a/backend/mariadb_utils.ml b/backend/mariadb_utils.ml index a9f9203..193971b 100644 --- a/backend/mariadb_utils.ml +++ b/backend/mariadb_utils.ml @@ -1,10 +1,10 @@ let find_request_sql - sql_select_columns - table_name - ?(default_where = None) - ?(count = false) - ?(joins = "") - where_fragment + sql_select_columns + table_name + ?(default_where = None) + ?(count = false) + ?(joins = "") + where_fragment = let where_fragment = CCOption.map_or ~default:where_fragment (fun default_where -> diff --git a/lib/guardian_entity.ml b/lib/guardian_entity.ml index b981f74..2b1ebe3 100644 --- a/lib/guardian_entity.ml +++ b/lib/guardian_entity.ml @@ -142,31 +142,32 @@ struct let remove_duplicates (perms : t list) : t list = CCList.fold_left - (fun init ({ permission; model; target_uuid } as permission_on_target) -> - let is_manage_model () = - equal - (of_tuple (Permission.Manage, model, None)) - permission_on_target - in - let model_permission () = - let in_list perm = - CCList.mem ~eq:equal (of_tuple (perm, model, None)) perms - in - in_list permission || in_list Permission.Manage - in - let manage_permission () = - CCList.mem (of_tuple (Permission.Manage, model, target_uuid)) perms - in - match target_uuid with - | None when is_manage_model () -> init @ [ permission_on_target ] - | None when manage_permission () -> init - | None -> init @ [ permission_on_target ] - | Some _ - when Permission.(equal Manage permission) - && model_permission () |> not -> - init @ [ permission_on_target ] - | Some _ when model_permission () || manage_permission () -> init - | Some _ -> init @ [ permission_on_target ]) + (fun init + ({ permission; model; target_uuid } as permission_on_target) -> + let is_manage_model () = + equal + (of_tuple (Permission.Manage, model, None)) + permission_on_target + in + let model_permission () = + let in_list perm = + CCList.mem ~eq:equal (of_tuple (perm, model, None)) perms + in + in_list permission || in_list Permission.Manage + in + let manage_permission () = + CCList.mem (of_tuple (Permission.Manage, model, target_uuid)) perms + in + match target_uuid with + | None when is_manage_model () -> init @ [ permission_on_target ] + | None when manage_permission () -> init + | None -> init @ [ permission_on_target ] + | Some _ + when Permission.(equal Manage permission) + && model_permission () |> not -> + init @ [ permission_on_target ] + | Some _ when model_permission () || manage_permission () -> init + | Some _ -> init @ [ permission_on_target ]) [] perms ;; @@ -191,9 +192,9 @@ struct filter_permission_on_model permission model %> CCList.fold_left (fun (init, uuids) { target_uuid; _ } -> - match target_uuid with - | Some uuid -> init, uuid :: uuids - | None -> true, uuids) + match target_uuid with + | Some uuid -> init, uuid :: uuids + | None -> true, uuids) (false, []) ;; end @@ -238,20 +239,20 @@ struct and type validation_set = ValidationSet.t module MakePersistence - (Backend : Persistence.Backend - with type actor = Actor.t - and type actor_model = ActorModel.t - and type actor_role = ActorRole.t - and type actor_permission = ActorPermission.t - and type permission_on_target = PermissionOnTarget.t - and type role = Role.t - and type role_assignment = RoleAssignment.t - and type role_permission = RolePermission.t - and type target = Target.t - and type target_entity = TargetEntity.t - and type target_model = TargetModel.t - and type validation_set = ValidationSet.t) : PersistenceSig = - struct + (Backend : + Persistence.Backend + with type actor = Actor.t + and type actor_model = ActorModel.t + and type actor_role = ActorRole.t + and type actor_permission = ActorPermission.t + and type permission_on_target = PermissionOnTarget.t + and type role = Role.t + and type role_assignment = RoleAssignment.t + and type role_permission = RolePermission.t + and type target = Target.t + and type target_entity = TargetEntity.t + and type target_model = TargetModel.t + and type validation_set = ValidationSet.t) : PersistenceSig = struct include Backend let clear_cache () = Repo.clear_cache () @@ -262,10 +263,10 @@ struct let insert_all ?ctx = Lwt_list.fold_left_s (fun acc x -> - match%lwt insert ?ctx x with - | Ok () -> CCResult.map (CCList.cons x) acc |> Lwt_result.lift - | Error (_ : string) -> - CCResult.map_err (CCList.cons x) acc |> Lwt_result.lift) + match%lwt insert ?ctx x with + | Ok () -> CCResult.map (CCList.cons x) acc |> Lwt_result.lift + | Error (_ : string) -> + CCResult.map_err (CCList.cons x) acc |> Lwt_result.lift) (Ok []) ;; end @@ -276,10 +277,10 @@ struct let insert_all ?ctx = Lwt_list.fold_left_s (fun acc x -> - match%lwt insert ?ctx x with - | Ok () -> CCResult.map (CCList.cons x) acc |> Lwt_result.lift - | Error (_ : string) -> - CCResult.map_err (CCList.cons x) acc |> Lwt_result.lift) + match%lwt insert ?ctx x with + | Ok () -> CCResult.map (CCList.cons x) acc |> Lwt_result.lift + | Error (_ : string) -> + CCResult.map_err (CCList.cons x) acc |> Lwt_result.lift) (Ok []) ;; end @@ -341,11 +342,11 @@ struct include PermissionOnTarget let validate_set - ?any_id - perms - (error : string -> 'etyp) - (validation_set : ValidationSet.t) - actor + ?any_id + perms + (error : string -> 'etyp) + (validation_set : ValidationSet.t) + actor = let open CCFun in let rec find_checker : validation_set -> bool = @@ -368,10 +369,9 @@ struct | true -> true | false -> CCList.fold_left - (flip (fun rule -> - function - | true -> true - | false -> find_checker rule)) + (flip (fun rule -> function + | true -> true + | false -> find_checker rule)) false rules) | And (rule :: rules) -> @@ -379,10 +379,9 @@ struct | false -> false | true -> CCList.fold_left - (flip (fun rule -> - function - | true -> find_checker rule - | false -> false)) + (flip (fun rule -> function + | true -> find_checker rule + | false -> false)) true rules) | Or [] | And [] -> true @@ -424,11 +423,11 @@ struct [actor] actor object who'd like to perform the action *) let validate - ?ctx - ?any_id - (error : string -> 'etyp) - (validation_set : ValidationSet.t) - actor + ?ctx + ?any_id + (error : string -> 'etyp) + (validation_set : ValidationSet.t) + actor : (unit, 'etyp) Lwt_result.t = let open CCFun in @@ -443,10 +442,9 @@ struct | true -> Lwt.return_true | false -> Lwt_list.fold_left_s - (flip (fun rule -> - function - | true -> Lwt.return_true - | false -> find_checker rule)) + (flip (fun rule -> function + | true -> Lwt.return_true + | false -> find_checker rule)) false rules) | And (rule :: rules) -> @@ -454,10 +452,9 @@ struct | false -> Lwt.return_false | true -> Lwt_list.fold_left_s - (flip (fun rule -> - function - | true -> find_checker rule - | false -> Lwt.return_false)) + (flip (fun rule -> function + | true -> find_checker rule + | false -> Lwt.return_false)) true rules) | Or [] | And [] -> Lwt.return_true @@ -482,10 +479,10 @@ struct [validation_set] effect set to check the permissions against *) let wrap_function - ?ctx - (error : string -> 'etyp) - (validation_set : ValidationSet.t) - (fcn : 'param -> ('rval, 'etyp) Lwt_result.t) + ?ctx + (error : string -> 'etyp) + (validation_set : ValidationSet.t) + (fcn : 'param -> ('rval, 'etyp) Lwt_result.t) = let open Lwt_result.Syntax in let can = validate ?ctx error validation_set in diff --git a/lib/role_set.ml b/lib/role_set.ml index 145d4a4..fb3ab9e 100644 --- a/lib/role_set.ml +++ b/lib/role_set.ml @@ -17,7 +17,7 @@ module Make (Role : Role.Sig) : Core with type elt = Role.t = struct | `List items -> CCList.fold_left (fun acc x -> - acc >>= fun acc' -> x |> Role.of_yojson >|= CCFun.flip add acc') + acc >>= fun acc' -> x |> Role.of_yojson >|= CCFun.flip add acc') (Ok empty) items | _ -> Error "Invalid role set" diff --git a/test/article.ml b/test/article.ml index 32211cb..ba98992 100644 --- a/test/article.ml +++ b/test/article.ml @@ -42,11 +42,11 @@ module Make (Backend : Guard.PersistenceSig) = struct ;; let update_author - ?ctx - (actor : Actor.t) - ({ id; _ } as article) - old_author - new_author + ?ctx + (actor : Actor.t) + ({ id; _ } as article) + old_author + new_author = let open Lwt_result.Syntax in let fcn (old_author, new_author) = diff --git a/test/main.ml b/test/main.ml index fa38125..c46b4b5 100644 --- a/test/main.ml +++ b/test/main.ml @@ -709,13 +709,13 @@ module Tests (Backend : Guard.PersistenceSig) = struct let%lwt () = Lwt_list.iter_s (fun (role, can_assign, expected) -> - let%lwt valid = - Backend.RoleAssignment.can_assign_roles ?ctx role - |> Lwt.map (CCList.exists (Role.Role.equal can_assign)) - in - Alcotest.( - check bool "check if role can assign a target role" expected valid) - |> Lwt.return) + let%lwt valid = + Backend.RoleAssignment.can_assign_roles ?ctx role + |> Lwt.map (CCList.exists (Role.Role.equal can_assign)) + in + Alcotest.( + check bool "check if role can assign a target role" expected valid) + |> Lwt.return) testables in (* Reset all RoleAssignments *) From 64b3cedef1a08eefad300d7d60717b3068782c04 Mon Sep 17 00:00:00 2001 From: Marc Biedermann Date: Mon, 24 Feb 2025 17:31:03 +0100 Subject: [PATCH 3/4] update github CI --- .github/workflows/ci.yml | 43 +++++++++++++++++++++++++--------------- 1 file changed, 27 insertions(+), 16 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 7b76093..b8959a4 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -28,31 +28,42 @@ jobs: strategy: fail-fast: false matrix: - ocaml-compiler: [4.14.x] + ocaml-compiler: + - 4.14 + - 5.2 + - 5.3 steps: - name: Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 + + - name: Retrieve opam cache + uses: actions/cache@v4 + if: runner.os != 'Windows' + id: cache-opam + with: + path: ~/.opam + key: v1-${{ runner.os }}-opam-${{ matrix.ocaml-compiler }}-${{ hashFiles('*.opam.locked') }} - name: Use OCaml ${{ matrix.ocaml-version }} - uses: ocaml/setup-ocaml@v2 + uses: ocaml/setup-ocaml@v3 with: ocaml-compiler: ${{ matrix.ocaml-compiler }} dune-cache: true opam-pin: true - opam-depext: false - name: Install system dependencies run: sudo apt-get update -y && sudo apt-get install -y libmariadb-dev - - name: Pin current guardian - run: | - opam pin add -yn guardian . - OPAMSOLVERTIMEOUT=180 opam depext --with-test --with-doc -y guardian - - name: Install dependencies run: opam install --deps-only --with-test --with-doc -y . + - name: Recover from an Opam broken state + if: steps.cache-opam.outputs.cache-hit == 'true' + run: | + opam install -y dune + opam upgrade --fixup + - name: Build run: | make build @@ -71,12 +82,12 @@ jobs: run: | make doc - - uses: actions/upload-artifact@v3 + - uses: actions/upload-artifact@v4 with: name: documentation path: _build/default/_doc/_html - - uses: actions/upload-artifact@v3 + - uses: actions/upload-artifact@v4 if: failure() with: name: tests @@ -98,13 +109,13 @@ jobs: url: ${{ steps.deploy-doc.outputs.page_url }} steps: - name: Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Download all workflow run artifacts - uses: actions/download-artifact@v3 + uses: actions/download-artifact@v4 - name: Deploy odoc to GitHub Pages - uses: peaceiris/actions-gh-pages@v3 + uses: peaceiris/actions-gh-pages@v4 with: github_token: ${{ github.token }} publish_dir: documentation @@ -121,13 +132,13 @@ jobs: if: github.ref_type == 'tag' steps: - name: Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: Extract version changelog run: sed -nr "/^## .?v?${GITHUB_REF_NAME}/,/^## /p" CHANGELOG.md | sed '1d;2d;$d' > changes.md - name: Create release - uses: softprops/action-gh-release@v1 + uses: softprops/action-gh-release@v2 with: token: ${{ secrets.GITHUB_TOKEN }} body_path: changes.md From 1ae7a2ca539ec9b9e223b1afe197db9460a2f48d Mon Sep 17 00:00:00 2001 From: Marc Biedermann Date: Mon, 24 Feb 2025 17:42:49 +0100 Subject: [PATCH 4/4] fix artifact name --- .github/workflows/ci.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index b8959a4..a028899 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -84,13 +84,13 @@ jobs: - uses: actions/upload-artifact@v4 with: - name: documentation + name: documentation-${{ matrix.ocaml-compiler }} path: _build/default/_doc/_html - uses: actions/upload-artifact@v4 if: failure() with: - name: tests + name: tests-${{ matrix.ocaml-compiler }} path: _build/default/test/_build/_tests/ - name: Notify about failure