Feature/maintenance 2502

.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

.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

.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,15 +82,15 @@ jobs:
         run: |
           make doc
 
-      - uses: actions/upload-artifact@v3
+      - uses: actions/upload-artifact@v4
         with:
-          name: documentation
+          name: documentation-${{ matrix.ocaml-compiler }}
           path: _build/default/_doc/_html
 
-      - uses: actions/upload-artifact@v3
+      - 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
@@ -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

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
   ;;

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

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 ->

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"}