(address . guix-patches@gnu.org)
20240903084447.17551-1-romain.garbage@inria.fr
* src/cuirass/gitlab.scm (gitlab-project): New record type.
(gitlab-event): New field PROJECT.
(gitlab-merge-request->specification): New project argument.
* src/cuirass/http.scm (url-hanlder): Update Gitlab API.
* tests/gitlab.scm: Fix tests.
* tests/http.scm: Fix tests.
---
src/cuirass/gitlab.scm | 25 ++++++++++----
src/cuirass/http.scm | 3 +-
tests/gitlab.scm | 74 +++++++++++++++++++++++++++---------------
tests/http.scm | 13 ++++++--
4 files changed, 78 insertions(+), 37 deletions(-)
Toggle diff (302 lines)
diff --git a/src/cuirass/gitlab.scm b/src/cuirass/gitlab.scm
index 4da9e82..fcb93bb 100644
--- a/src/cuirass/gitlab.scm
+++ b/src/cuirass/gitlab.scm
@@ -23,9 +23,14 @@
#:use-module (ice-9 match)
#:export (gitlab-event
gitlab-event-type
+ gitlab-event-project
gitlab-event-value
json->gitlab-event
+ gitlab-project
+ gitlab-project-name
+ json->gitlab-project
+
gitlab-merge-request
gitlab-merge-request-action
gitlab-merge-request-project-name
@@ -48,6 +53,13 @@
(name gitlab-source-name "name"
string->symbol))
+(define-json-mapping <gitlab-project>
+ make-gitlab-project
+ gitlab-project?
+ json->gitlab-project
+ (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).
@@ -111,6 +123,8 @@
#\-
c))
v))))
+ (project gitlab-event-project "project"
+ json->gitlab-project)
(value gitlab-event-value "object_attributes"
(lambda (v)
;; FIXME: properly handle cases using field TYPE defined above.
@@ -120,10 +134,9 @@
(json->gitlab-merge-request v))
(#t #f)))))
-(define (gitlab-merge-request->specification merge-request)
+(define (gitlab-merge-request->specification merge-request project)
"Returns a SPECIFICATION built out of a GITLAB-MERGE-REQUEST."
- (let* ((source-name (gitlab-source-name
- (gitlab-merge-request-source merge-request)))
+ (let* ((project-name (gitlab-project-name project))
(source-branch (gitlab-merge-request-source-branch merge-request))
(source-url (gitlab-source-repo-url
(gitlab-merge-request-source merge-request)))
@@ -135,13 +148,13 @@
'gitlab-merge-requests))
(spec-name (string->symbol
(format #f "~a-~a-~a-~a" name-prefix
- source-name
+ project-name
source-branch
id)))
(build (if (and cuirass-options
(jobset-options-build cuirass-options))
(jobset-options-build cuirass-options)
- `(channels ,source-name)))
+ `(channels ,project-name)))
(period (if (and cuirass-options
(jobset-options-period cuirass-options))
(jobset-options-period cuirass-options)
@@ -159,7 +172,7 @@
(build build)
(channels
(cons* (channel
- (name source-name)
+ (name project-name)
(url source-url)
(branch source-branch))
%default-channels))
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 27cf18f..0ac22df 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -723,7 +723,8 @@ return DEFAULT."
(match (gitlab-event-type event)
('merge-request
(let* ((merge-request (gitlab-event-value event))
- (spec (gitlab-merge-request->specification merge-request)))
+ (project (gitlab-event-project event))
+ (spec (gitlab-merge-request->specification merge-request project)))
(match (gitlab-merge-request-action merge-request)
;; New merge request.
((or "open" "reopen")
diff --git a/tests/gitlab.scm b/tests/gitlab.scm
index b670138..ca6cad5 100644
--- a/tests/gitlab.scm
+++ b/tests/gitlab.scm
@@ -36,6 +36,9 @@
(define default-mr-json
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"project-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -51,6 +54,9 @@
(define custom-mr-json
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"project-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -79,6 +85,9 @@
(define custom-mr-json-multiple-packages
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"project-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -103,6 +112,9 @@
(define custom-mr-json-name-prefix
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"project-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -121,6 +133,9 @@
(define custom-mr-json-build-all
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"project-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -168,15 +183,16 @@
(test-assert "default-json"
(specifications-equal?
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event default-mr-json)))
+ (let ((event (json->gitlab-event default-mr-json)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event)))
(specification
- (name 'gitlab-merge-requests-test-project-test-branch-1)
- (build '(channels . (test-project)))
+ (name 'gitlab-merge-requests-project-name-test-branch-1)
+ (build '(channels . (project-name)))
(channels
(cons* (channel
- (name 'test-project)
+ (name 'project-name)
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
@@ -186,15 +202,16 @@
(test-assert "custom-json"
(specifications-equal?
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event custom-mr-json)))
+ (let ((event (json->gitlab-event custom-mr-json)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event)))
(specification
- (name 'gitlab-merge-requests-test-project-test-branch-2)
+ (name 'gitlab-merge-requests-project-name-test-branch-2)
(build '(manifests . ("manifest")))
(channels
(cons* (channel
- (name 'test-project)
+ (name 'project-name)
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
@@ -205,15 +222,16 @@
(test-assert "custom-json-multiple-packages"
(specifications-equal?
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event custom-mr-json-multiple-packages)))
+ (let ((event (json->gitlab-event custom-mr-json-multiple-packages)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event)))
(specification
- (name 'gitlab-merge-requests-test-project-test-branch-1)
+ (name 'gitlab-merge-requests-project-name-test-branch-1)
(build '(packages . ("package1" "package2" "package3")))
(channels
(cons* (channel
- (name 'test-project)
+ (name 'project-name)
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
@@ -223,15 +241,16 @@
(test-assert "custom-json-name-prefix"
(specifications-equal?
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event custom-mr-json-name-prefix)))
+ (let ((event (json->gitlab-event custom-mr-json-name-prefix)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event)))
(specification
- (name 'prefix-test-project-test-branch-1)
- (build '(channels . (test-project)))
+ (name 'prefix-project-name-test-branch-1)
+ (build '(channels . (project-name)))
(channels
(cons* (channel
- (name 'test-project)
+ (name 'project-name)
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
@@ -241,15 +260,16 @@
(test-assert "custom-json-build-all"
(specifications-equal?
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event custom-mr-json-build-all)))
+ (let ((event (json->gitlab-event custom-mr-json-build-all)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event)))
(specification
- (name 'gitlab-merge-requests-test-project-test-branch-2)
+ (name 'gitlab-merge-requests-project-name-test-branch-2)
(build 'all)
(channels
(cons* (channel
- (name 'test-project)
+ (name 'project-name)
(url "https://gitlab.instance.test/source-repo/fork-name.git")
(branch "test-branch"))
%default-channels))
diff --git a/tests/http.scm b/tests/http.scm
index bdd2b7d..3fdbaad 100644
--- a/tests/http.scm
+++ b/tests/http.scm
@@ -93,6 +93,9 @@
(define mr-json-open
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"test-name\"
+ },
\"object_attributes\": {
\"action\": \"open\",
\"merge_status\": \"can_be_merged\",
@@ -108,6 +111,9 @@
(define mr-json-close
"{
\"event_type\": \"merge_request\",
+ \"project\": {
+ \"name\": \"test-name\"
+ },
\"object_attributes\": {
\"action\": \"close\",
\"merge_status\": \"can_be_merged\",
@@ -121,9 +127,10 @@
}")
(define mr-spec
- (gitlab-merge-request->specification
- (gitlab-event-value
- (json->gitlab-event mr-json-open))))
+ (let ((event (json->gitlab-event mr-json-open)))
+ (gitlab-merge-request->specification
+ (gitlab-event-value event)
+ (gitlab-event-project event))))
(define-syntax-rule (with-cuirass-register exp ...)
(with-guix-daemon
base-commit: 59010a5ba32a5f0802d28900908ee9c75f473a66
--
2.45.2