From eec771592820077eb4bfa7e1acac02d85b9e9c53 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Wed, 16 Jul 2025 20:24:33 +0200
Subject: [PATCH] forgejo: Enqueue the repository URL, not the pull request
 URL.

Previously the pull request URL (say,
https://codeberg.org/guix/guix/pulls/123) would be mistaken for the Git
repository URL.
---
 guix-data-service/forgejo.scm | 25 ++++++++++++++++---------
 tests/forgejo.scm             |  9 ++++++---
 2 files changed, 22 insertions(+), 12 deletions(-)

diff --git a/guix-data-service/forgejo.scm b/guix-data-service/forgejo.scm
index f149529..42e06ba 100644
--- a/guix-data-service/forgejo.scm
+++ b/guix-data-service/forgejo.scm
@@ -106,16 +106,17 @@
   (if (forgejo-pull-request-draft? pull-request)
       (format #t "skipping Forgejo pull request draft ~s~%"
               (forgejo-pull-request-url pull-request))
-      (let* ((url (forgejo-pull-request-url pull-request))
+      (let* ((date (time-utc->date (current-time time-utc))) ;XXX: approximate?
+             (reference (forgejo-pull-request-head pull-request))
+             (repository (forgejo-repository-reference-repository reference))
+             (url (forgejo-repository-url repository))
+             (branch (forgejo-repository-reference-ref reference))
+             (commit (forgejo-repository-reference-sha reference))
+             (label (forgejo-repository-reference-label reference))
              (repository-id (git-repository-url->git-repository-id
                              conn url
                              ;; Disable channel authentication for PRs.
                              #:authenticate? #f))
-             (date (time-utc->date (current-time time-utc))) ;XXX: approximate?
-             (reference (forgejo-pull-request-head pull-request))
-             (branch (forgejo-repository-reference-ref reference))
-             (commit (forgejo-repository-reference-sha reference))
-             (label (forgejo-repository-reference-label reference))
 
              (branch-id (or (git-branch-for-repository-and-name
                              conn repository-id branch)
@@ -124,13 +125,18 @@
         (unless (git-commit-exists? conn commit)
           (insert-git-commit-entry conn branch-id commit date))
 
+        (format #t "queuing commit ~a of branch '~a' of repository ~a for PR #~a~%"
+                commit branch url
+                (forgejo-pull-request-number pull-request))
         (enqueue-load-new-guix-revision-job conn repository-id
                                             commit label))))
 
 (define (mark-pull-request-branch-for-deletion conn pull-request)
   "Mark the branch associated with @var{pull-request}, a pull request being
 closed, for deletion."
-  (let* ((url (forgejo-pull-request-url pull-request))
+  (let* ((reference (forgejo-pull-request-head pull-request))
+         (repository (forgejo-repository-reference-repository reference))
+         (url (forgejo-repository-url repository))
          (repository-id (git-repository-url->git-repository-id
                          conn url #:create-if-missing? #f)))
     (when repository-id
@@ -142,6 +148,7 @@ closed, for deletion."
         (when branch-id
           ;; Insert a commit entry with the empty string: this is interpreted
           ;; as BRANCH-ID being a candidate for deletion.
-          (format #t "marking pull request branch ~s of ~s for deletion~%"
-                  branch url)
+          (format #t "marking branch '~a' of ~a (PR #~a) for deletion~%"
+                  branch url
+                  (forgejo-pull-request-number pull-request))
           (insert-git-commit-entry conn branch-id "" date))))))
diff --git a/tests/forgejo.scm b/tests/forgejo.scm
index 3716c48..52de5af 100644
--- a/tests/forgejo.scm
+++ b/tests/forgejo.scm
@@ -30,6 +30,9 @@
 (define pull-request-url
   "https://forgejo.example.org/base-repo/pulls/1")
 
+(define pull-request-clone-url
+  "https://forgejo.example.org/source-repo/fork-name.git")
+
 (define pull-request-commit
   "582af40e8a059fa05c7048a7ac4f2eccbbd0183b")
 
@@ -69,7 +72,7 @@
           },
           \"name\": \"fork-name\",
           \"full_name\": \"fork-owner/fork-name\",
-          \"clone_url\": \"https://forgejo.example.org/source-repo/fork-name.git\",
+          \"clone_url\": \"" pull-request-clone-url "\",
           \"html_url\": \"https://forgejo.example.org/source-repo/fork-name\"
         }
       }
@@ -94,7 +97,7 @@
 
       (test-equal "all-git-repositories"
         `((label . #f)
-          (url . ,pull-request-url)
+          (url . ,pull-request-clone-url)
           (link-url . #f)
           (x-git-repo-header . #f)
           (included-branches . #f)
@@ -107,7 +110,7 @@
           (commit-range-link-url-template . #f)
           (file-link-url-template . #f))
         (match (find (lambda (alist)
-                       (equal? (assoc-ref alist 'url) pull-request-url))
+                       (equal? (assoc-ref alist 'url) pull-request-clone-url))
                      (all-git-repositories conn))
           ((('id . id) rest ...)
            ;; Since the ID might vary depending on other tests run on this