Package: guix-patches;
Reported by: Romain GARBAGE <romain.garbage <at> inria.fr>
Date: Tue, 10 Dec 2024 16:09:02 UTC
Severity: normal
Tags: patch
Done: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Romain GARBAGE <romain.garbage <at> inria.fr> To: 74769 <at> debbugs.gnu.org Cc: ludovic.courtes <at> inria.fr, Romain GARBAGE <romain.garbage <at> inria.fr> Subject: [bug#74769] [PATCH Cuirass v2 5/7] forgejo: Add module for Forgejo JSON objects definition. Date: Thu, 12 Dec 2024 16:57:53 +0100
* 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 <at> 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 <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.