cbaines/guix-data-service
1
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

forgejo: Enqueue the repository URL, not the pull request URL.

Browse source 
Previously the pull request URL (say,
https://codeberg.org/guix/guix/pulls/123) would be mistaken for the Git
repository URL.
This commit is contained in:
Ludovic Courtès 2025-07-16 20:24:33 +02:00
parent b35c26a74e
commit eec7715928
2 changed files with 22 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

25
guix-data-service/forgejo.scm
View file

@ -106,16 +106,17 @@
(if (forgejo-pull-request-draft? pull-request) (if (forgejo-pull-request-draft? pull-request)
(format #t "skipping Forgejo pull request draft ~s~%" (format #t "skipping Forgejo pull request draft ~s~%"
(forgejo-pull-request-url pull-request)) (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 (repository-id (git-repository-url->git-repository-id
conn url conn url
;; Disable channel authentication for PRs. ;; Disable channel authentication for PRs.
#:authenticate? #f)) #: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 (branch-id (or (git-branch-for-repository-and-name
conn repository-id branch) conn repository-id branch)
@ -124,13 +125,18 @@
(unless (git-commit-exists? conn commit) (unless (git-commit-exists? conn commit)
(insert-git-commit-entry conn branch-id commit date)) (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 (enqueue-load-new-guix-revision-job conn repository-id
commit label)))) commit label))))
(define (mark-pull-request-branch-for-deletion conn pull-request) (define (mark-pull-request-branch-for-deletion conn pull-request)
"Mark the branch associated with @var{pull-request}, a pull request being "Mark the branch associated with @var{pull-request}, a pull request being
closed, for deletion." 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 (repository-id (git-repository-url->git-repository-id
conn url #:create-if-missing? #f))) conn url #:create-if-missing? #f)))
(when repository-id (when repository-id
@ -142,6 +148,7 @@ closed, for deletion."
(when branch-id (when branch-id
;; Insert a commit entry with the empty string: this is interpreted ;; Insert a commit entry with the empty string: this is interpreted
;; as BRANCH-ID being a candidate for deletion. ;; as BRANCH-ID being a candidate for deletion.
(format #t "marking pull request branch ~s of ~s for deletion~%" (format #t "marking branch '~a' of ~a (PR #~a) for deletion~%"
branch url) branch url
(forgejo-pull-request-number pull-request))
(insert-git-commit-entry conn branch-id "" date)))))) (insert-git-commit-entry conn branch-id "" date))))))

9
tests/forgejo.scm
View file

@ -30,6 +30,9 @@
(define pull-request-url (define pull-request-url
"https://forgejo.example.org/base-repo/pulls/1") "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 (define pull-request-commit
"582af40e8a059fa05c7048a7ac4f2eccbbd0183b") "582af40e8a059fa05c7048a7ac4f2eccbbd0183b")
@ -69,7 +72,7 @@
}, },
\"name\": \"fork-name\", \"name\": \"fork-name\",
\"full_name\": \"fork-owner/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\" \"html_url\": \"https://forgejo.example.org/source-repo/fork-name\"
} }
} }
@ -94,7 +97,7 @@
(test-equal "all-git-repositories" (test-equal "all-git-repositories"
`((label . #f) `((label . #f)
(url . ,pull-request-url) (url . ,pull-request-clone-url)
(link-url . #f) (link-url . #f)
(x-git-repo-header . #f) (x-git-repo-header . #f)
(included-branches . #f) (included-branches . #f)
@ -107,7 +110,7 @@
(commit-range-link-url-template . #f) (commit-range-link-url-template . #f)
(file-link-url-template . #f)) (file-link-url-template . #f))
(match (find (lambda (alist) (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)) (all-git-repositories conn))
((('id . id) rest ...) ((('id . id) rest ...)
;; Since the ID might vary depending on other tests run on this ;; Since the ID might vary depending on other tests run on this