From: Romain GARBAGE <romain.garbage@inria.fr>
To: 74769@debbugs.gnu.org
Cc: ludovic.courtes@inria.fr, Romain GARBAGE <romain.garbage@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 [thread overview]
Message-ID: <20241212155845.27344-5-romain.garbage@inria.fr> (raw)
In-Reply-To: <20241212155845.27344-1-romain.garbage@inria.fr>
* 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
next prev parent reply other threads:[~2024-12-12 16:00 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-12-10 16:01 [bug#74769] [PATCH Cuirass 0/4] Forgejo event support Romain GARBAGE
2024-12-10 16:09 ` [bug#74769] [PATCH Cuirass 1/4] tests: Move procedure definition Romain GARBAGE
2024-12-10 16:09 ` [bug#74769] [PATCH Cuirass 2/4] forgejo: Add module for Forgejo JSON objects definition Romain GARBAGE
2024-12-12 13:34 ` Ludovic Courtès
2024-12-10 16:09 ` [bug#74769] [PATCH Cuirass 3/4] tests: Explicit Gitlab endpoint related variables Romain GARBAGE
2024-12-10 16:09 ` [bug#74769] [PATCH Cuirass 4/4] http: Add admin/forgejo/event Romain GARBAGE
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 ` [bug#74769] [PATCH Cuirass v2 4/7] forges: Define default values for specifications Romain GARBAGE
2024-12-12 15:57 ` Romain GARBAGE [this message]
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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20241212155845.27344-5-romain.garbage@inria.fr \
--to=romain.garbage@inria.fr \
--cc=74769@debbugs.gnu.org \
--cc=ludovic.courtes@inria.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).