* [bug#74769] [PATCH Cuirass v2 2/7] tests: Rename specifications-equal? procedure.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 3/7] forges: Add module for common forges utilities Romain GARBAGE
` (4 subsequent siblings)
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* tests/common.scm (specifications=?): New variable.
(specifications-equal?): Remove variable.
* tests/gitlab.scm: Use new variable name.
---
tests/common.scm | 4 ++--
tests/gitlab.scm | 10 +++++-----
2 files changed, 7 insertions(+), 7 deletions(-)
diff --git a/tests/common.scm b/tests/common.scm
index 5054ea0..488d8db 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -31,7 +31,7 @@
test-init-db!
with-guix-daemon
wait-for-bridge
- specifications-equal?))
+ specifications=?))
(define %db
(make-parameter #f))
@@ -125,7 +125,7 @@ Return the socket on success and #f on failure."
(strerror (system-error-errno args)))
#f)))))))
-(define (specifications-equal? spec1 spec2)
+(define (specifications=? spec1 spec2)
"Return true if SPEC2 and SPEC2 are equivalent, false otherwise."
(and (eq? (specification-name spec1)
(specification-name spec2))
diff --git a/tests/gitlab.scm b/tests/gitlab.scm
index adf94cc..117a94d 100644
--- a/tests/gitlab.scm
+++ b/tests/gitlab.scm
@@ -158,7 +158,7 @@
}")
(test-assert "default-json"
- (specifications-equal?
+ (specifications=?
(let ((event (json->gitlab-event default-mr-json)))
(gitlab-merge-request->specification
(gitlab-event-value event)
@@ -177,7 +177,7 @@
(systems (list "x86_64-linux")))))
(test-assert "custom-json"
- (specifications-equal?
+ (specifications=?
(let ((event (json->gitlab-event custom-mr-json)))
(gitlab-merge-request->specification
(gitlab-event-value event)
@@ -197,7 +197,7 @@
"aarch64-linux")))))
(test-assert "custom-json-multiple-packages"
- (specifications-equal?
+ (specifications=?
(let ((event (json->gitlab-event custom-mr-json-multiple-packages)))
(gitlab-merge-request->specification
(gitlab-event-value event)
@@ -216,7 +216,7 @@
(systems (list "x86_64-linux")))))
(test-assert "custom-json-name-prefix"
- (specifications-equal?
+ (specifications=?
(let ((event (json->gitlab-event custom-mr-json-name-prefix)))
(gitlab-merge-request->specification
(gitlab-event-value event)
@@ -235,7 +235,7 @@
(systems (list "x86_64-linux")))))
(test-assert "custom-json-build-all"
- (specifications-equal?
+ (specifications=?
(let ((event (json->gitlab-event custom-mr-json-build-all)))
(gitlab-merge-request->specification
(gitlab-event-value event)
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread* [bug#74769] [PATCH Cuirass v2 3/7] forges: Add module for common forges utilities.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 2/7] tests: Rename specifications-equal? procedure Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 4/7] forges: Define default values for specifications Romain GARBAGE
` (3 subsequent siblings)
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* Makefile.am: Update module list.
* src/cuirass/forges.scm: New module.
* src/cuirass/gitlab.scm: Moved to src/cuirass/forges/gitlab.scm.
* src/cuirass/http.scm, tests/gitlab.scm, tests/http.scm: Update module header.
---
Makefile.am | 3 +-
src/cuirass/forges.scm | 73 +++++++++++++++++++++++++++++
src/cuirass/{ => forges}/gitlab.scm | 41 ++--------------
src/cuirass/http.scm | 2 +-
tests/gitlab.scm | 2 +-
tests/http.scm | 2 +-
6 files changed, 81 insertions(+), 42 deletions(-)
create mode 100644 src/cuirass/forges.scm
rename src/cuirass/{ => forges}/gitlab.scm (80%)
diff --git a/Makefile.am b/Makefile.am
index 1123eb1..2de3419 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -52,7 +52,8 @@ dist_pkgmodule_DATA = \
src/cuirass/store.scm \
src/cuirass/base.scm \
src/cuirass/database.scm \
- src/cuirass/gitlab.scm \
+ src/cuirass/forges.scm \
+ src/cuirass/forges/gitlab.scm \
src/cuirass/http.scm \
src/cuirass/logging.scm \
src/cuirass/mail.scm \
diff --git a/src/cuirass/forges.scm b/src/cuirass/forges.scm
new file mode 100644
index 0000000..c05e266
--- /dev/null
+++ b/src/cuirass/forges.scm
@@ -0,0 +1,73 @@
+;;; forges.scm -- Common forges utilities
+;;; Copyright © 2024 Romain Garbage <romain.garbage@inria.fr>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (cuirass forges)
+ #:use-module (cuirass specification)
+ #:use-module (json)
+ #:use-module (ice-9 match)
+ #:export (make-jobset-options
+ jobset-options?
+ json->jobset-options
+ jobset-options-name-prefix
+ jobset-options-build
+ jobset-options-period
+ jobset-options-priority
+ jobset-options-systems))
+
+;;; Commentary:
+;;;
+;;; This module implements objects and default values used in the various
+;;; forges modules.
+;;;
+;;; Code:
+
+;; This mapping defines a specific JSON dictionary used for tweaking Cuirass
+;; options. It is not included in the JSON data sent by default by Gitlab and
+;; must be used through the custom template mechanism (see documentation).
+(define-json-mapping <jobset-options>
+ make-jobset-options
+ jobset-options?
+ json->jobset-options
+ (name-prefix jobset-options-name-prefix "name_prefix"
+ (lambda (v)
+ (if (unspecified? v)
+ #f
+ (string->symbol v))))
+ (build jobset-options-build "build"
+ (match-lambda
+ ((? unspecified?)
+ #f)
+ (((key . val) _ ...)
+ (cons (string->symbol key) (vector->list val)))
+ (str
+ (string->symbol str))))
+ (period jobset-options-period "period"
+ (lambda (v)
+ (if (unspecified? v)
+ #f
+ v)))
+ (priority jobset-options-priority "priority"
+ (lambda (v)
+ (if (unspecified? v)
+ #f
+ v)))
+ (systems jobset-options-systems "systems"
+ (lambda (v)
+ (if (unspecified? v)
+ #f
+ (vector->list v)))))
diff --git a/src/cuirass/gitlab.scm b/src/cuirass/forges/gitlab.scm
similarity index 80%
rename from src/cuirass/gitlab.scm
rename to src/cuirass/forges/gitlab.scm
index fcb93bb..56e875a 100644
--- a/src/cuirass/gitlab.scm
+++ b/src/cuirass/forges/gitlab.scm
@@ -1,5 +1,5 @@
;;;; gitlab.scm -- Gitlab JSON mappings
-;;; Copyright © 2024 Romain Garbage <guix-devel@rgarbage.fr>
+;;; Copyright © 2024 Romain Garbage <romain.garbage@inria.fr>
;;;
;;; This file is part of Cuirass.
;;;
@@ -16,7 +16,8 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(define-module (cuirass gitlab)
+(define-module (cuirass forges gitlab)
+ #:use-module (cuirass forges)
#:use-module (cuirass specification)
#:use-module (json)
#:use-module (guix channels)
@@ -60,42 +61,6 @@
(name gitlab-project-name "name"
string->symbol))
-;; This mapping defines a specific JSON dictionary used for tweaking Cuirass
-;; options. It is not included in the JSON data sent by default by Gitlab and
-;; must be used through the custom template mechanism (see documentation).
-(define-json-mapping <jobset-options>
- make-jobset-options
- jobset-options?
- json->jobset-options
- (name-prefix jobset-options-name-prefix "name_prefix"
- (lambda (v)
- (if (unspecified? v)
- #f
- (string->symbol v))))
- (build jobset-options-build "build"
- (match-lambda
- ((? unspecified?)
- #f)
- (((key . val) _ ...)
- (cons (string->symbol key) (vector->list val)))
- (str
- (string->symbol str))))
- (period jobset-options-period "period"
- (lambda (v)
- (if (unspecified? v)
- #f
- v)))
- (priority jobset-options-priority "priority"
- (lambda (v)
- (if (unspecified? v)
- #f
- v)))
- (systems jobset-options-systems "systems"
- (lambda (v)
- (if (unspecified? v)
- #f
- (vector->list v)))))
-
(define-json-mapping <gitlab-merge-request>
make-gitlab-merge-request
gitlab-merge-request?
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 881e803..8ea929f 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -27,7 +27,7 @@
#:use-module (cuirass config)
#:use-module (cuirass database)
#:use-module ((cuirass base) #:select (evaluation-log-file))
- #:use-module (cuirass gitlab)
+ #:use-module (cuirass forges gitlab)
#:use-module (cuirass metrics)
#:use-module (cuirass utils)
#:use-module (cuirass logging)
diff --git a/tests/gitlab.scm b/tests/gitlab.scm
index 117a94d..df221bf 100644
--- a/tests/gitlab.scm
+++ b/tests/gitlab.scm
@@ -16,7 +16,7 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (cuirass gitlab)
+(use-modules (cuirass forges gitlab)
(cuirass specification)
(cuirass utils)
(tests common)
diff --git a/tests/http.scm b/tests/http.scm
index 7b8ab03..541f30d 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -22,7 +22,7 @@
(use-modules ((cuirass base) #:select (%bridge-socket-file-name))
(cuirass http)
(cuirass database)
- (cuirass gitlab)
+ (cuirass forges gitlab)
(cuirass specification)
(cuirass utils)
(tests common)
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread* [bug#74769] [PATCH Cuirass v2 4/7] forges: Define default values for specifications.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 2/7] tests: Rename specifications-equal? procedure Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 3/7] forges: Add module for common forges utilities Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 5/7] forgejo: Add module for Forgejo JSON objects definition Romain GARBAGE
` (2 subsequent siblings)
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* src/cuirass/forges.scm (%default-jobset-options-period,
%default-jobset-options-priority, %default-jobset-options-systems): New
variables.
* src/cuirass/forges/gitlab.scm (gitlab-merge-request->specification),
tests/gitlab.scm: Change hardcoded values to variables defined in the forges
module.
---
src/cuirass/forges.scm | 16 +++++++++++++++-
src/cuirass/forges/gitlab.scm | 6 +++---
tests/gitlab.scm | 21 +++++++++++----------
3 files changed, 29 insertions(+), 14 deletions(-)
diff --git a/src/cuirass/forges.scm b/src/cuirass/forges.scm
index c05e266..56f4876 100644
--- a/src/cuirass/forges.scm
+++ b/src/cuirass/forges.scm
@@ -20,7 +20,11 @@
#:use-module (cuirass specification)
#:use-module (json)
#:use-module (ice-9 match)
- #:export (make-jobset-options
+ #:export (%default-jobset-options-period
+ %default-jobset-options-priority
+ %default-jobset-options-systems
+
+ make-jobset-options
jobset-options?
json->jobset-options
jobset-options-name-prefix
@@ -36,6 +40,16 @@
;;;
;;; Code:
+;; Default polling period for jobsets created using a forge module.
+(define %default-jobset-options-period 3600)
+
+;; Default priority for jobsets created using a forge module.
+(define %default-jobset-options-priority 5)
+
+;; Default target systems for jobsets created using a forge module.
+(define %default-jobset-options-systems
+ (list "x86_64-linux"))
+
;; This mapping defines a specific JSON dictionary used for tweaking Cuirass
;; options. It is not included in the JSON data sent by default by Gitlab and
;; must be used through the custom template mechanism (see documentation).
diff --git a/src/cuirass/forges/gitlab.scm b/src/cuirass/forges/gitlab.scm
index 56e875a..de2216f 100644
--- a/src/cuirass/forges/gitlab.scm
+++ b/src/cuirass/forges/gitlab.scm
@@ -123,15 +123,15 @@
(period (if (and cuirass-options
(jobset-options-period cuirass-options))
(jobset-options-period cuirass-options)
- 3600))
+ %default-jobset-options-period))
(priority (if (and cuirass-options
(jobset-options-priority cuirass-options))
(jobset-options-priority cuirass-options)
- 1))
+ %default-jobset-options-priority))
(systems (if (and cuirass-options
(jobset-options-systems cuirass-options))
(jobset-options-systems cuirass-options)
- (list "x86_64-linux"))))
+ %default-jobset-options-systems)))
(specification
(name spec-name)
(build build)
diff --git a/tests/gitlab.scm b/tests/gitlab.scm
index df221bf..3409413 100644
--- a/tests/gitlab.scm
+++ b/tests/gitlab.scm
@@ -16,7 +16,8 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
-(use-modules (cuirass forges gitlab)
+(use-modules (cuirass forges)
+ (cuirass forges gitlab)
(cuirass specification)
(cuirass utils)
(tests common)
@@ -172,9 +173,9 @@
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
- (priority 1)
- (period 3600)
- (systems (list "x86_64-linux")))))
+ (priority %default-jobset-options-priority)
+ (period %default-jobset-options-period)
+ (systems %default-jobset-options-systems))))
(test-assert "custom-json"
(specifications=?
@@ -211,9 +212,9 @@
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
- (priority 1)
- (period 3600)
- (systems (list "x86_64-linux")))))
+ (priority %default-jobset-options-priority)
+ (period %default-jobset-options-period)
+ (systems %default-jobset-options-systems))))
(test-assert "custom-json-name-prefix"
(specifications=?
@@ -230,9 +231,9 @@
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
- (priority 1)
- (period 3600)
- (systems (list "x86_64-linux")))))
+ (priority %default-jobset-options-priority)
+ (period %default-jobset-options-period)
+ (systems %default-jobset-options-systems))))
(test-assert "custom-json-build-all"
(specifications=?
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread* [bug#74769] [PATCH Cuirass v2 5/7] forgejo: Add module for Forgejo JSON objects definition.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
` (2 preceding siblings ...)
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 4/7] forges: Define default values for specifications Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 6/7] tests: Explicit Gitlab endpoint related variables Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 7/7] http: Add admin/forgejo/event Romain GARBAGE
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* Makefile.am: Add src/cuirass/forges/forgejo.scm and tests/forgejo.scm.
* src/cuirass/forges/forgejo.scm: Add <forgejo-repository>,
<forgejo-pull-request-event>, <forgejo-pull-request>,
<forgejo-repository-reference> and <forgejo-repo> record types.
(forgejo-pull-request->specification): New variable.
* tests/forgejo.scm: Add tests.
---
Makefile.am | 2 +
src/cuirass/forges/forgejo.scm | 134 +++++++++++++++++++++++++++++++++
tests/forgejo.scm | 80 ++++++++++++++++++++
3 files changed, 216 insertions(+)
create mode 100644 src/cuirass/forges/forgejo.scm
create mode 100644 tests/forgejo.scm
diff --git a/Makefile.am b/Makefile.am
index 2de3419..f38703e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -53,6 +53,7 @@ dist_pkgmodule_DATA = \
src/cuirass/base.scm \
src/cuirass/database.scm \
src/cuirass/forges.scm \
+ src/cuirass/forges/forgejo.scm \
src/cuirass/forges/gitlab.scm \
src/cuirass/http.scm \
src/cuirass/logging.scm \
@@ -168,6 +169,7 @@ TESTS = \
## tests/basic.sh # takes too long to execute
tests/store.scm \
tests/database.scm \
+ tests/forgejo.scm \
tests/gitlab.scm \
tests/http.scm \
tests/metrics.scm \
diff --git a/src/cuirass/forges/forgejo.scm b/src/cuirass/forges/forgejo.scm
new file mode 100644
index 0000000..11133f4
--- /dev/null
+++ b/src/cuirass/forges/forgejo.scm
@@ -0,0 +1,134 @@
+;;; forgejo.scm -- Forgejo JSON mappings
+;;; Copyright © 2024 Romain Garbage <romain.garbage@inria.fr>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (cuirass forges forgejo)
+ #:use-module (cuirass specification)
+ #:use-module (cuirass forges)
+ #:use-module (json)
+ #:use-module (web http)
+ #:use-module (guix channels)
+ #:use-module (ice-9 match)
+ #:export (forgejo-pull-request-event-pull-request
+ forgejo-pull-request-event-action
+ json->forgejo-pull-request-event
+
+ forgejo-repository-name
+ forgejo-repository-url
+
+ json->forgejo-pull-request
+
+ forgejo-pull-request->specification))
+
+;;; Commentary:
+;;;
+;;; This module implements a subset of the Forgejo Webhook API described at
+;;; <https://forgejo.org/docs/latest/user/webhooks/>.
+;;;
+;;; Code:
+
+;; This declares a specific header for internal consumption, specifically when
+;; generating requests during tests.
+(declare-opaque-header! "X-Forgejo-Event")
+
+(define-json-mapping <forgejo-repository>
+ make-forgejo-repository
+ forgejo-repository?
+ json->forgejo-repository
+ (name forgejo-repository-name "name"
+ string->symbol)
+ (url forgejo-repository-url "clone_url"))
+
+;; This maps to the top level JSON object.
+(define-json-mapping <forgejo-pull-request-event>
+ make-forgejo-pull-request-event
+ forgejo-pull-request-event?
+ json->forgejo-pull-request-event
+ (action forgejo-pull-request-event-action "action"
+ string->symbol)
+ (pull-request forgejo-pull-request-event-pull-request "pull_request"
+ json->forgejo-pull-request))
+
+(define-json-mapping <forgejo-pull-request>
+ make-forgejo-pull-request
+ forgejo-pull-request?
+ json->forgejo-pull-request
+ (number forgejo-pull-request-number "number")
+ (base forgejo-pull-request-base "base"
+ json->forgejo-repository-reference)
+ (head forgejo-pull-request-head "head"
+ json->forgejo-repository-reference))
+
+;; This mapping is used to define various JSON objects such as "base" or
+;; "head".
+(define-json-mapping <forgejo-repository-reference>
+ make-forgejo-repository-reference
+ forgejo-repository-reference?
+ json->forgejo-repository-reference
+ (label forgejo-repository-reference-label "label")
+ (ref forgejo-repository-reference-ref "ref")
+ (sha forgejo-repository-reference-sha "sha")
+ (repository forgejo-repository-reference-repository "repo"
+ json->forgejo-repository))
+
+(define* (forgejo-pull-request->specification pull-request #:optional (cuirass-options #f))
+ "Returns a SPECIFICATION built out of a FORGEJO-PULL-REQUEST."
+ (let* ((source-repo-reference (forgejo-pull-request-head pull-request))
+ (project-name (forgejo-repository-name
+ (forgejo-repository-reference-repository
+ (forgejo-pull-request-base pull-request))))
+ (source-branch (forgejo-repository-reference-ref source-repo-reference))
+ (source-url (forgejo-repository-url
+ (forgejo-repository-reference-repository source-repo-reference)))
+ (id (forgejo-pull-request-number pull-request))
+ (name-prefix (if (and cuirass-options
+ (jobset-options-name-prefix cuirass-options))
+ (jobset-options-name-prefix cuirass-options)
+ 'forgejo-pull-requests))
+ (spec-name (string->symbol
+ (format #f "~a-~a-~a-~a" name-prefix
+ project-name
+ source-branch
+ id)))
+ (build (if (and cuirass-options
+ (jobset-options-build cuirass-options))
+ (jobset-options-build cuirass-options)
+ `(channels ,project-name)))
+ (period (if (and cuirass-options
+ (jobset-options-period cuirass-options))
+ (jobset-options-period cuirass-options)
+ %default-jobset-options-period))
+ (priority (if (and cuirass-options
+ (jobset-options-priority cuirass-options))
+ (jobset-options-priority cuirass-options)
+ %default-jobset-options-priority))
+ (systems (if (and cuirass-options
+ (jobset-options-systems cuirass-options))
+ (jobset-options-systems cuirass-options)
+ %default-jobset-options-systems)))
+ (specification
+ (name spec-name)
+ (build build)
+ (channels
+ (cons* (channel
+ (name project-name)
+ (url source-url)
+ (branch source-branch))
+ %default-channels))
+ (priority priority)
+ (period period)
+ (systems systems))))
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
new file mode 100644
index 0000000..fb3e99f
--- /dev/null
+++ b/tests/forgejo.scm
@@ -0,0 +1,80 @@
+;;; forgejo.scm -- tests for (cuirass forgejo) module
+;;; Copyright © 2024 Romain GARBAGE <romain.garbage@inria.fr>
+;;;
+;;; This file is part of Cuirass.
+;;;
+;;; Cuirass is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Cuirass is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (cuirass forges)
+ (cuirass forges forgejo)
+ (cuirass specification)
+ (cuirass utils)
+ (tests common)
+ (guix channels)
+ (json)
+ (fibers)
+ (squee)
+ (web uri)
+ (web client)
+ (web response)
+ (rnrs bytevectors)
+ (srfi srfi-1)
+ (srfi srfi-64)
+ (ice-9 threads)
+ (ice-9 match))
+
+(define default-pull-request-json
+ "{
+ \"action\": \"opened\",
+ \"pull_request\": {
+ \"number\": 1,
+ \"state\": \"open\",
+ \"base\": {
+ \"label\": \"base-label\",
+ \"ref\": \"base-branch\",
+ \"sha\": \"666af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"project-name\",
+ \"clone_url\": \"https://forgejo.instance.test/base-repo/project-name.git\"
+ }
+ },
+ \"head\": {
+ \"label\": \"test-label\",
+ \"ref\": \"test-branch\",
+ \"sha\": \"582af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"fork-name\",
+ \"clone_url\": \"https://forgejo.instance.test/source-repo/fork-name.git\"
+ }
+ }
+ }
+ }")
+
+(test-assert "default-json"
+ (specifications=?
+ (let ((event (json->forgejo-pull-request-event default-pull-request-json)))
+ (forgejo-pull-request->specification
+ (forgejo-pull-request-event-pull-request event)))
+ (specification
+ (name 'forgejo-pull-requests-project-name-test-branch-1)
+ (build '(channels . (project-name)))
+ (channels
+ (cons* (channel
+ (name 'project-name)
+ (url "https://forgejo.instance.test/source-repo/fork-name.git")
+ (branch "test-branch"))
+ %default-channels))
+ (priority %default-jobset-options-priority)
+ (period %default-jobset-options-period)
+ (systems %default-jobset-options-systems))))
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread* [bug#74769] [PATCH Cuirass v2 6/7] tests: Explicit Gitlab endpoint related variables.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
` (3 preceding siblings ...)
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 5/7] forgejo: Add module for Forgejo JSON objects definition Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 7/7] http: Add admin/forgejo/event Romain GARBAGE
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* tests/http.scm: Rename mr-* variables to gitlab-merge-request-*.
---
tests/http.scm | 22 +++++++++++-----------
1 file changed, 11 insertions(+), 11 deletions(-)
diff --git a/tests/http.scm b/tests/http.scm
index 541f30d..aa58e78 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -90,7 +90,7 @@
(channel . "packages")
(directory . "dir2")))))))
-(define mr-json-open
+(define gitlab-merge-request-json-open
"{
\"event_type\": \"merge_request\",
\"project\": {
@@ -108,7 +108,7 @@
}
}")
-(define mr-json-close
+(define gitlab-merge-request-json-close
"{
\"event_type\": \"merge_request\",
\"project\": {
@@ -126,8 +126,8 @@
}
}")
-(define mr-spec
- (let ((event (json->gitlab-event mr-json-open)))
+(define gitlab-merge-request-spec
+ (let ((event (json->gitlab-event gitlab-merge-request-json-open)))
(gitlab-merge-request->specification
(gitlab-event-value event)
(gitlab-event-project event))))
@@ -438,24 +438,24 @@
(specification-channels spec)))))))
(test-equal "/admin/gitlab/event creates a spec from a new merge request"
- (specification-name mr-spec)
+ (specification-name gitlab-merge-request-spec)
(begin
- (http-post-json (test-cuirass-uri "/admin/gitlab/event") mr-json-open)
- (specification-name (db-get-specification (specification-name mr-spec)))))
+ (http-post-json (test-cuirass-uri "/admin/gitlab/event") gitlab-merge-request-json-open)
+ (specification-name (db-get-specification (specification-name gitlab-merge-request-spec)))))
(test-equal "/admin/gitlab/event error when a merge request has already been created"
400
- (response-code (http-post-json (test-cuirass-uri "/admin/gitlab/event") mr-json-open)))
+ (response-code (http-post-json (test-cuirass-uri "/admin/gitlab/event") gitlab-merge-request-json-open)))
(test-assert "/admin/gitlab/event removes a spec from a closed merge request"
(begin
- (http-post-json (test-cuirass-uri "/admin/gitlab/event") mr-json-close)
- (not (db-get-specification (specification-name mr-spec)))))
+ (http-post-json (test-cuirass-uri "/admin/gitlab/event") gitlab-merge-request-json-close)
+ (not (db-get-specification (specification-name gitlab-merge-request-spec)))))
(test-equal "/admin/gitlab/event error when a merge request has already been closed"
404
(response-code (http-post-json (test-cuirass-uri "/admin/gitlab/event")
- mr-json-close)))
+ gitlab-merge-request-json-close)))
(test-assert "db-close"
(begin
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread* [bug#74769] [PATCH Cuirass v2 7/7] http: Add admin/forgejo/event.
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 1/7] tests: Move procedure definition Romain GARBAGE
` (4 preceding siblings ...)
2024-12-12 15:57 ` [bug#74769] [PATCH Cuirass v2 6/7] tests: Explicit Gitlab endpoint related variables Romain GARBAGE
@ 2024-12-12 15:57 ` Romain GARBAGE
5 siblings, 0 replies; 13+ messages in thread
From: Romain GARBAGE @ 2024-12-12 15:57 UTC (permalink / raw)
To: 74769; +Cc: ludovic.courtes, Romain GARBAGE
* src/cuirass/http.scm (url-handler): Add "/admin/forgejo/event".
* tests/http.scm: Add tests for the "/admin/forgejo/event" endpoint.
* doc/cuirass.texi: Reorganize "Interfacing Cuirass..." section. Add
documentation for the "/admin/forgejo/event" endpoint.
---
doc/cuirass.texi | 38 ++++++++++++++++--
src/cuirass/http.scm | 64 +++++++++++++++++++++++++++++-
tests/http.scm | 93 +++++++++++++++++++++++++++++++++++++++++++-
3 files changed, 188 insertions(+), 7 deletions(-)
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 13739c9..895d91f 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -1284,11 +1284,14 @@ This request accepts a mandatory parameter.
Limit query result to nr elements. This parameter is @emph{mandatory}.
@end table
-@section Interfacing Cuirass with a GitLab Server
+@section Interfacing Cuirass with a Git forge
-Cuirass supports integration with GitLab through the @dfn{webhook} mechanism:
-a POST request is sent by a GitLab instance whenever a specific event is
-triggered. So far, Cuirass only support merge-request events.
+Cuirass supports integration with various forges through the
+@dfn{webhook} mechanism: a POST request is sent by the forge instance
+whenever a specific event is triggered. So far, Cuirass only support
+merge-request/pull-request events.
+
+@subsection Interfacing with a GitLab Server
Sending a merge request event on the @code{/admin/gitlab/event} endpoint
allows controlling a specific jobset related to the merge request
@@ -1330,6 +1333,33 @@ A JSON list of strings. Each string must be a supported system, i.e.
@code{"systems": [ "x86_64-linux", "aarch64-linux" ]}
@end table
+@subsection Interfacing with a Forgejo Server
+
+Sending a merge request event on the @code{/admin/forgejo/event}
+endpoint allows controlling a specific jobset related to the merge
+request content. This interface expect the JSON data to contain the
+following keys:
+@table @code
+@item "action"
+@item "pull_request.number"
+@item "pull_request.state"
+@item "pull_request.base.label"
+@item "pull_request.base.ref"
+@item "pull_request.base.sha"
+@item "pull_request.base.repo.name"
+@item "pull_request.base.repo.clone_url"
+@item "pull_request.head.label"
+@item "pull_request.head.ref"
+@item "pull_request.head.sha"
+@item "pull_request.head.repo.name"
+@item "pull_request.head.repo.clone_url"
+@end table
+
+The resulting jobset, named as
+@code{forgejo-pull-requests-@var{pull_request}.@var{base}.@var{pull_request}.@var{name}-@var{pull_request}.@var{head}.@var{ref}-@var{pull_request}.@var{number}},
+is set to build the channel corresponding to the source branch in the
+merge request data with a priority of 1.
+
@c *********************************************************************
@node Database
@chapter Database schema
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 8ea929f..0a6bfae 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Tatiana Sholokhova <tanja201396@gmail.com>
;;; Copyright © 2019, 2020 Ricardo Wurmus <rekado@elephly.net>
-;;; Copyright © 2024 Romain Garbage <guix-devel@rgarbage.fr>
+;;; Copyright © 2024 Romain Garbage <romain.garbage@inria.fr>
;;;
;;; This file is part of Cuirass.
;;;
@@ -28,6 +28,7 @@
#:use-module (cuirass database)
#:use-module ((cuirass base) #:select (evaluation-log-file))
#:use-module (cuirass forges gitlab)
+ #:use-module (cuirass forges forgejo)
#:use-module (cuirass metrics)
#:use-module (cuirass utils)
#:use-module (cuirass logging)
@@ -779,6 +780,67 @@ return DEFAULT."
(event-type (respond-json-with-error 400 (format #f "Event type \"~a\" not supported." event-type))))
(respond-json-with-error 400 "This API only supports JSON."))))
+ ;; Define an API for Forgejo events
+ (('POST "admin" "forgejo" "event")
+ (let* ((params (utf8->string body))
+ (event-type (assoc-ref (request-headers request) 'x-forgejo-event))
+ (content-type (assoc-ref (request-headers request) 'content-type))
+ (json? (equal? (car content-type)
+ 'application/json)))
+ (if json?
+ (match event-type
+ ("pull_request"
+ (let* ((event (json->forgejo-pull-request-event params))
+ (pull-request (forgejo-pull-request-event-pull-request event))
+ (spec (forgejo-pull-request->specification pull-request))
+ (spec-name (specification-name spec)))
+ (match (forgejo-pull-request-event-action event)
+ ;; New pull request.
+ ((or 'opened 'reopened)
+ (if (not (db-get-specification spec-name))
+ (begin
+ (db-add-or-update-specification spec)
+
+ (unless (call-bridge `(register-jobset ,spec-name)
+ bridge)
+ (log-warning
+ "cannot notify bridge of the addition of jobset '~a'"
+ spec-name))
+ (respond
+ (build-response #:code 200
+ #:headers
+ `((location . ,(string->uri-reference "/"))))
+ #:body ""))
+ (begin
+ (log-warning "jobset '~a' already exists" spec-name)
+ (respond-json-with-error 400 "Jobset already exists."))))
+ ;; Closed or merged pull request.
+ ('closed
+ (if (db-get-specification spec-name)
+ (begin
+ (call-bridge `(remove-jobset ,spec-name) bridge)
+ (log-info "Removed jobset '~a'" spec-name)
+ (respond
+ (build-response #:code 200
+ #:headers
+ `((location . ,(string->uri-reference "/"))))
+ #:body ""))
+ (begin
+ (log-warning "cannot find jobset '~a'" spec-name)
+ (respond-json-with-error 404 "Jobset not found."))))
+ ;; Pull request is updated.
+ ('synchronized
+ (if (db-get-specification spec-name)
+ (if (call-bridge `(trigger-jobset ,(specification-name spec))
+ bridge)
+ (respond-json (scm->json-string `((jobset . ,spec-name))))
+ (begin
+ (log-warning "evaluation hook disabled")
+ (respond-json-with-error 400 "Evaluation hook disabled.")))
+ (respond-json-with-error 404 "Jobset not found."))))))
+ (_ (respond-json-with-error 400 (format #f "Event type \"~a\" not supported." event-type))))
+ (respond-json-with-error 400 "This API only supports JSON."))))
+
(('POST "admin" "specification" "add")
(let* ((spec (body->specification body))
(name (specification-name spec)))
diff --git a/tests/http.scm b/tests/http.scm
index aa58e78..862e06b 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2017-2020, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017, 2020, 2021 Mathieu Othacehe <othacehe@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2024 Romain Garbage <romain.garbage@inria.fr>
;;;
;;; This file is part of Cuirass.
;;;
@@ -22,6 +23,7 @@
(use-modules ((cuirass base) #:select (%bridge-socket-file-name))
(cuirass http)
(cuirass database)
+ (cuirass forges forgejo)
(cuirass forges gitlab)
(cuirass specification)
(cuirass utils)
@@ -43,8 +45,9 @@
(call-with-values (lambda () (http-get uri))
(lambda (response body) body)))
-(define (http-post-json uri body)
- (http-post uri #:body body #:headers '((content-type application/json))))
+(define* (http-post-json uri body #:optional (extra-headers '()))
+ (http-post uri #:body body #:headers (append '((content-type application/json))
+ extra-headers)))
(define (wait-until-ready port)
;; Wait until the server is accepting connections.
@@ -132,6 +135,65 @@
(gitlab-event-value event)
(gitlab-event-project event))))
+(define forgejo-pull-request-json-open
+ "{
+ \"action\": \"opened\",
+ \"pull_request\": {
+ \"number\": 1,
+ \"state\": \"open\",
+ \"base\": {
+ \"label\": \"base-label\",
+ \"ref\": \"base-branch\",
+ \"sha\": \"666af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"project-name\",
+ \"clone_url\": \"https://forgejo.instance.test/base-repo/project-name.git\"
+ }
+ },
+ \"head\": {
+ \"label\": \"test-label\",
+ \"ref\": \"test-branch\",
+ \"sha\": \"582af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"fork-name\",
+ \"clone_url\": \"https://forgejo.instance.test/source-repo/fork-name.git\"
+ }
+ }
+ }
+ }")
+
+(define forgejo-pull-request-json-close
+ "{
+ \"action\": \"closed\",
+ \"pull_request\": {
+ \"number\": 1,
+ \"state\": \"closed\",
+ \"base\": {
+ \"label\": \"base-label\",
+ \"ref\": \"base-branch\",
+ \"sha\": \"666af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"project-name\",
+ \"clone_url\": \"https://forgejo.instance.test/base-repo/project-name.git\"
+ }
+ },
+ \"head\": {
+ \"label\": \"test-label\",
+ \"ref\": \"test-branch\",
+ \"sha\": \"582af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+ \"repo\": {
+ \"name\": \"fork-name\",
+ \"clone_url\": \"https://forgejo.instance.test/source-repo/fork-name.git\"
+ }
+ }
+ }
+ }")
+
+(define forgejo-pull-request-specification
+ (forgejo-pull-request->specification
+ (forgejo-pull-request-event-pull-request
+ (json->forgejo-pull-request-event forgejo-pull-request-json-open))))
+
(define-syntax-rule (with-cuirass-register exp ...)
(with-guix-daemon
(let ((pid #f))
@@ -457,6 +519,33 @@
(response-code (http-post-json (test-cuirass-uri "/admin/gitlab/event")
gitlab-merge-request-json-close)))
+ (test-equal "/admin/forgejo/event creates a spec from a new pull request"
+ (specification-name forgejo-pull-request-specification)
+ (begin
+ (http-post-json (test-cuirass-uri "/admin/forgejo/event")
+ forgejo-pull-request-json-open
+ '((x-forgejo-event . "pull_request")))
+ (specification-name (db-get-specification (specification-name forgejo-pull-request-specification)))))
+
+ (test-equal "/admin/forgejo/event error when a pull request has already been created"
+ 400
+ (response-code (http-post-json (test-cuirass-uri "/admin/forgejo/event")
+ forgejo-pull-request-json-open
+ '((x-forgejo-event . "pull_request")))))
+
+ (test-assert "/admin/forgejo/event removes a spec from a closed pull request"
+ (begin
+ (http-post-json (test-cuirass-uri "/admin/forgejo/event")
+ forgejo-pull-request-json-close
+ '((x-forgejo-event . "pull_request")))
+ (not (db-get-specification (specification-name forgejo-pull-request-specification)))))
+
+ (test-equal "/admin/forgejo/event error when a pull request has already been closed"
+ 404
+ (response-code (http-post-json (test-cuirass-uri "/admin/forgejo/event")
+ forgejo-pull-request-json-close
+ '((x-forgejo-event . "pull_request")))))
+
(test-assert "db-close"
(begin
(db-close (%db))
--
2.46.0
^ permalink raw reply related [flat|nested] 13+ messages in thread