Add support for Forgejo web hooks.

Populate the ‘git_repositories’ and ‘load_new_guix_revision_jobs’ table
when receiving a POST request corresponding to a Forgejo pull-request
webhook.

tests/forgejo.scm

@@ -0,0 +1,134 @@
+;;; forgejo.scm -- Test support for Forgejo pull requests
+;;; Copyright © 2024, 2025 Romain Garbage <romain.garbage@inria.fr>
+;;; Copyright © 2025 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; 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 (test-forgejo)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-64)
+  #:use-module (ice-9 match)
+  #:use-module ((ice-9 string-fun) #:select (string-replace-substring))
+  #:use-module (guix-data-service database)
+  #:use-module (guix-data-service model git-repository)
+  #:use-module (guix-data-service model git-commit)
+  #:use-module (guix-data-service forgejo))
+
+(define pull-request-url
+  "https://forgejo.example.org/base-repo/pulls/1")
+
+(define pull-request-commit
+  "582af40e8a059fa05c7048a7ac4f2eccbbd0183b")
+
+(define pull-request-new-commit
+  (string-reverse pull-request-commit))
+
+(define pull-request-event-json
+  (string-append "{
+    \"action\": \"opened\",
+    \"pull_request\": {
+      \"number\": 1,
+      \"state\": \"open\",
+      \"draft\": false,
+      \"url\": \"" pull-request-url "\",
+      \"body\": \"Some content.\",
+      \"base\": {
+        \"label\": \"base-label\",
+        \"ref\": \"base-branch\",
+        \"sha\": \"666af40e8a059fa05c7048a7ac4f2eccbbd0183b\",
+        \"repo\": {
+          \"owner\": {
+            \"login\": \"project-owner\"
+          },
+          \"name\": \"project-name\",
+          \"full_name\": \"base-repo/project-name\",
+          \"clone_url\": \"https://forgejo.example.org/base-repo/project-name.git\",
+          \"html_url\": \"https://forgejo.example.org/base-repo/project-name\"
+        }
+      },
+      \"head\": {
+        \"label\": \"test-label\",
+        \"ref\": \"test-branch\",
+        \"sha\": \"" pull-request-commit "\",
+        \"repo\": {
+          \"owner\": {
+            \"login\": \"fork-owner\"
+          },
+          \"name\": \"fork-name\",
+          \"full_name\": \"fork-owner/fork-name\",
+          \"clone_url\": \"https://forgejo.example.org/source-repo/fork-name.git\",
+          \"html_url\": \"https://forgejo.example.org/source-repo/fork-name\"
+        }
+      }
+    }
+  }"))
+
+(test-begin "forgejo")
+
+(with-postgresql-connection
+ "test-forgejo"
+ (lambda (conn)
+   (check-test-database! conn)
+
+   (with-postgresql-transaction
+    conn
+    (lambda (conn)
+      (test-assert "enqueue-job-for-pull-request, initial commit"
+        (let* ((event (json->forgejo-pull-request-event
+                       pull-request-event-json))
+               (pull (forgejo-pull-request-event-pull-request event)))
+          (enqueue-job-for-pull-request conn pull)))
+
+      (test-equal "all-git-repositories"
+        `((label . #f)
+          (url . ,pull-request-url)
+          (link-url . #f)
+          (x-git-repo-header . #f)
+          (included-branches . #f)
+          (excluded-branches . #f)
+          (fetch-with-authentication? . #f)   ;authentication disabled for PRs
+          (query-substitutes? . #t)
+          (poll-interval . #f)
+          (job-priority . 0)
+          (commit-link-url-template . #f)
+          (commit-range-link-url-template . #f)
+          (file-link-url-template . #f))
+        (match (find (lambda (alist)
+                       (equal? (assoc-ref alist 'url) pull-request-url))
+                     (all-git-repositories conn))
+          ((('id . id) rest ...)
+           ;; Since the ID might vary depending on other tests run on this
+           ;; database, strip it.
+           rest)))
+
+      (test-assert "git-commit-exists?, initial commit"
+        (and (git-commit-exists? conn pull-request-commit)
+             (not (git-commit-exists? conn pull-request-new-commit))))
+
+      (test-assert "enqueue-job-for-pull-request, updating pull request"
+        (let* ((event (json->forgejo-pull-request-event
+                       (string-replace-substring pull-request-event-json
+                                                 pull-request-commit
+                                                 pull-request-new-commit)))
+               (pull (forgejo-pull-request-event-pull-request event)))
+          (enqueue-job-for-pull-request conn pull)))
+
+      (test-assert "git-commit-exists?, new commit"
+        (git-commit-exists? conn pull-request-new-commit)))
+
+    #:always-rollback? #t)))
+
+(test-end)